Topic: help with coordinate table lisp

[PM]

Hi .I am using this code to insert a table with coordinates from a txt file in autocad. Can anyone update this code to calculate the dinstanse between the points . I attach a dwg file with the tables (i have two types .I prefrerethe right but if it is not possible and the left do the job  ) , and a txt file with the coordinates

Code - Auto/Visual Lisp: [Select]

1. (defun c:PXY ( / *error* del des ent idx lst obj ord out rtn sel )
2.  
3.     (defun *error* ( msg )
4.         (if (= 'file (type des))
5.             (close des)
6.         )
7.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
8.             (princ (strcat "\nError: " msg))
9.         )
10.         (princ)
11.     )
12.  
13.     (setq ord '("POINT" POINT-X POINT-Y )
14.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".txt")
15.           del  ","
16.     )
17.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
18.         (if (setq des (open out "w"))
19.             (progn
20.                 (repeat (setq idx (sslength sel))
21.                     (setq ent (ssname sel (setq idx (1- idx)))
22.                           obj (vlax-ename->vla-object ent)
23.                     )
24.                     (setq lst
25.                         (append
26.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
27.                                '(point-x point-y point-z)
28.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
29.                             )
30.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
31.                                 (append
32.                                     (vlax-invoke obj 'getattributes)
33.                                     (vlax-invoke obj 'getconstantattributes)
34.                                 )
35.                             )
36.                         )
37.                     )
38.                   ;(setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))                    
39. (if (and (setq pnt (assoc "POINT" lst)) (/= "" (cdr pnt)))
40.         (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
41.     )
42.                 )
43.        (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
44.        (write-line (LM:lst->str (nth idx rtn) del) des)
45.         )
46.                 (setq des (close des))
47.             )
48.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
49.         )
50.     )
51.     (princ)
52. )                
53.  
54. ;; List to String  -  Lee Mac
55. ;; Concatenates each string in a list, separated by a given delimiter
56.  
57. (defun LM:lst->str ( lst del )
58.     (if (cdr lst)
59.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
60.         (car lst)
61.     )
62. )
63.  
64. ;; Unique Filename  -  Lee Mac
65. ;; Returns a unique filename for a given path & file extension
66.  
67. (defun LM:uniquefilename ( pth ext / fnm tmp )
68.     (if (findfile (setq fnm (strcat pth ext)))
69.         (progn
70.             (setq tmp 1)
71.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
72.         )
73.     )
74.     fnm
75. )
76. ;; Alphanumerical Sort-i  -  Lee Mac
77. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
78.  
79. (defun LM:alphanumsort-i ( lst )
80.     (vl-sort-i (mapcar 'LM:splitstring lst)
81.         (function
82.             (lambda ( a b / x y )
83.                 (while
84.                     (and
85.                         (setq x (car a))
86.                         (setq y (car b))
87.                         (= x y)
88.                     )
89.                     (setq a (cdr a)
90.                           b (cdr b)
91.                     )
92.                 )
93.                 (cond
94.                     (   (null x) b)
95.                     (   (null y) nil)
96.                     (   (and (numberp x) (numberp y)) (< x y))
97.                     (   (numberp x))
98.                     (   (numberp y) nil)
99.                     (   (< x y))
100.                 )
101.             )
102.         )
103.     )
104. )
105.  
106. ;; Split String  -  Lee Mac
107. ;; Splits a string into a list of text and numbers
108.  
109. (defun LM:splitstring ( str )
110.     (
111.         (lambda ( l )
112.             (read
113.                 (strcat "("
114.                     (vl-list->string
115.                         (apply 'append
116.                             (mapcar
117.                                 (function
118.                                     (lambda ( a b c )
119.                                         (cond
120.                                             (   (or (= 34 b) (= 92 b))
121.                                                 (list 32 34 92 b 34 32)
122.                                             )
123.                                             (   (or (< 47 b 58)
124.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
125.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
126.                                                 )
127.                                                 (list b)
128.                                             )
129.                                             (   (list 32 34 b 34 32))
130.                                         )
131.                                     )
132.                                 )
133.                                 (cons nil l) l (append (cdr l) '(( )))
134.                             )
135.                         )
136.                     )
137.                     ")"
138.                 )
139.             )
140.         )
141.         (vl-string->list str)
142.     )
143. )
144.  
145. (vl-load-com) (princ)
146.  

Thanks

[PM]

Is not possible ?

Thanks

[BIGAL]

Did you google pline to table should be out there already.

Right table much easier, the code provided above is maybe an over kill.

Just need a parse csv to make a list of txt file. Re Lee-mac

(Distance (list x1 y1)(list x2 y2)) use the nth function for 1-2 2-3 3-4  use (repeat (- (length lst) 1 then do last 4-1, can also do a trick copy 1st xy to list as a close.

Here is a sample make table to get you started. You need a merge cells function for last 2 lines (vla-mergecells tblobj minrow maxrow mincol maxcol)

Code: [Select]

; make table example
; By Alan H info@alanh.com.au
; 2018

(defun c:ahmaketable (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao vgms)
(vl-load-com)
(setq sp (vlax-3d-point (getpoint "pick a point for table")))


(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ;

(setq numrows 5)
(setq numcolumns 5)
(setq rowheight 2.5)
(setq colwidth 60)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "DRAWING REGISTER"); TABLE TITLE
(vla-settext objtable 1 0 "DRAWING NUMBER")
(vla-settext objtable 1 1 "DRAWING TITLE")
(vla-settext objtable 1 2 "C")
(vla-settext objtable 1 3 "D")
(vla-settext objtable 1 4 "E")
(vla-settext objtable 2 0 "1")
(vla-settext objtable 3 0 "2")
(vla-settext objtable 4 0 "3")
(command "_zoom" "e")

(princ)
)

[\code]

[PM]

Hi BIGAL. I am using block attribiutes for points in my drawings. I export the coordinates in txt file. The point numbers is not allways 1-2-3-4 , will be k1-3-6a-5-7-23-45-32 etc radom. So i use this code to convert the txt file to table.This is the code i use to export the coordinates to a file (*.crd). I dont know if is possible to convert this file to export P,X,Y,L   (point number,coord X,coord Y ,Length) and repeat the first line to the end of the file.

Code - Auto/Visual Lisp: [Select]

1. (defun c:PXY ( / *error* del des ent idx lst obj ord out rtn sel )
2.  
3.     (defun *error* ( msg )
4.         (if (= 'file (type des))
5.             (close des)
6.         )
7.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
8.             (princ (strcat "\nError: " msg))
9.         )
10.         (princ)
11.     )
12.  
13.     (setq ord '("POINT" POINT-X POINT-Y )
14.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
15.           del  ","
16.     )
17.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
18.         (if (setq des (open out "w"))
19.             (progn
20.                 (repeat (setq idx (sslength sel))
21.                     (setq ent (ssname sel (setq idx (1- idx)))
22.                           obj (vlax-ename->vla-object ent)
23.                     )
24.                     (setq lst
25.                         (append
26.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
27.                                '(point-x point-y point-z)
28.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
29.                             )
30.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
31.                                 (append
32.                                     (vlax-invoke obj 'getattributes)
33.                                     (vlax-invoke obj 'getconstantattributes)
34.                                 )
35.                             )
36.                         )
37.                     )
38.                   ;(setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))                    
39. (if (and (setq pnt (assoc "POINT" lst)) (/= "" (cdr pnt)))
40.         (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
41.     )
42.                 )
43.        (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
44.        (write-line (LM:lst->str (nth idx rtn) del) des)
45.         )
46.                 (setq des (close des))
47.             )
48.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
49.         )
50.     )
51.     (princ)
52. )                
53.  
54. ;; List to String  -  Lee Mac
55. ;; Concatenates each string in a list, separated by a given delimiter
56.  
57. (defun LM:lst->str ( lst del )
58.     (if (cdr lst)
59.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
60.         (car lst)
61.     )
62. )
63.  
64. ;; Unique Filename  -  Lee Mac
65. ;; Returns a unique filename for a given path & file extension
66.  
67. (defun LM:uniquefilename ( pth ext / fnm tmp )
68.     (if (findfile (setq fnm (strcat pth ext)))
69.         (progn
70.             (setq tmp 1)
71.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
72.         )
73.     )
74.     fnm
75. )
76. ;; Alphanumerical Sort-i  -  Lee Mac
77. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
78.  
79. (defun LM:alphanumsort-i ( lst )
80.     (vl-sort-i (mapcar 'LM:splitstring lst)
81.         (function
82.             (lambda ( a b / x y )
83.                 (while
84.                     (and
85.                         (setq x (car a))
86.                         (setq y (car b))
87.                         (= x y)
88.                     )
89.                     (setq a (cdr a)
90.                           b (cdr b)
91.                     )
92.                 )
93.                 (cond
94.                     (   (null x) b)
95.                     (   (null y) nil)
96.                     (   (and (numberp x) (numberp y)) (< x y))
97.                     (   (numberp x))
98.                     (   (numberp y) nil)
99.                     (   (< x y))
100.                 )
101.             )
102.         )
103.     )
104. )
105.  
106. ;; Split String  -  Lee Mac
107. ;; Splits a string into a list of text and numbers
108.  
109. (defun LM:splitstring ( str )
110.     (
111.         (lambda ( l )
112.             (read
113.                 (strcat "("
114.                     (vl-list->string
115.                         (apply 'append
116.                             (mapcar
117.                                 (function
118.                                     (lambda ( a b c )
119.                                         (cond
120.                                             (   (or (= 34 b) (= 92 b))
121.                                                 (list 32 34 92 b 34 32)
122.                                             )
123.                                             (   (or (< 47 b 58)
124.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
125.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
126.                                                 )
127.                                                 (list b)
128.                                             )
129.                                             (   (list 32 34 b 34 32))
130.                                         )
131.                                     )
132.                                 )
133.                                 (cons nil l) l (append (cdr l) '(( )))
134.                             )
135.                         )
136.                     )
137.                     ")"
138.                 )
139.             )
140.         )
141.         (vl-string->list str)
142.     )
143. )
144.  
145. (vl-load-com) (princ)
146.  

Thanks

[d2010]

Hi BIGAL. I am using block attribiutes for points in my drawings. I export the coordinates in txt file.

You do not need Extract 'Coordinates to CSV file. Your programe can extract iCadastral-Infromations directly from the "CL_aclayer-dorinmur-sanpaul.dwg"
You execute the "pp_tabelpol_jsdup35.lsp" with command XTB[enter]

[PM]

i can not understant .What program ?

[d2010]

You try the programe "pp_tabelpol_jsdup35.lsp" with xtb[enter]

i can not understant .What program ?

[PM]

i dont have any pp_tabelpol_jsdup35.lsp and i dont know what is  xtb

[BIGAL]

Download the zip file.

[PM]

I see now the zip file .was on top of the image and i see only the gif file