Topic: Help to update a Dimension polyline lisp

[mhy3sx]

Hi ,I am using this code to dimension polylines for Cross sections

To work correct the cross section must be in the correct position (0,Datum). This is not all the times possible

This code works for 2 layers of ground. Select the ground line and the pick insert point for length and insert point for elevetion.

So I want to do some updates

1) Pick a point of the theoretic  (0,Datum) (to correct the length and elevetion if the polyline is not in (0,Datum))
2) Only for layer2 draw 4 extra lines  (look the test.dwg )
The 3 and 4 steps in test.dwg already exist in the code, but the elevetion and distance will be correct with the step 1

Look the test.DWG to understand Better.

Code - Auto/Visual Lisp: [Select]

1.  
2.     (defun err (s)
3.       (if (= s "Function cancelled")
4.         (princ "\nVERTEXT - cancelled: ")
5.         (progn (princ "\nVERTEXT - Error: ") (princ s) (terpri))
6.         ) ;_ end of if
7.       (resetting)
8.       (princ "SYSTEM VARIABLES have been reset\n")
9.       (princ)
10.       ) ;_ end of defun
11.     (defun setv (systvar newval)
12.       (setq x (read (strcat systvar "1")))
13.       (set x (getvar systvar))
14.       (setvar systvar newval)
15.       ) ;_ end of defun
16.     (defun setting () (setq oerr *error*) (setq *error* err) (setv "CMDECHO" 0) (setv "BLIPMODE" 0))
17.     (defun rsetv (systvar) (setq x (read (strcat systvar "1"))) (setvar systvar (eval x)))
18.      
19.     (defun resetting () (rsetv "CMDECHO") (rsetv "BLIPMODE") (setq *error* oerr))
20.      
21.      
22.     (defun dxf (code ename) (cdr (assoc code (entget ename)))) ; dxf
23.      
24.     (defun vertext (mode / en vlist)
25.       (setq en (get-en))
26.       (if (= (dxf 0 en) "LWPOLYLINE")
27.         (setq vlist (get-lwvlist en))
28.         (setq vlist (get-plvlist en))
29.         ) ;_ end of if
30.       (write-it vlist en mode)
31.       ) ;_ end of defun
32.      
33.     (defun get-en (/ no-ent en msg1 msg2)
34.       (setq no-ent 1
35.             en     nil
36.             msg1   "\nselect polyline: "
37.             msg2   "\nTry again !!!."
38.             ) ; setq
39.       (while no-ent
40.         (setq en (car (entsel msg1)))
41.         (if (and en
42.                  (or (= (dxf 0 en) "LWPOLYLINE") (= (dxf 0 en) "POLYLINE")) ; or
43.                  ) ; and
44.           (progn (setq no-ent nil)) ; progn
45.           (prompt msg2)
46.           )   ; if
47.         )     ; while
48.       en
49.       )       ; get-en
50.      
51.     (defun get-lwvlist (en / elist num-vert vlist)
52.       (setq elist    (entget en)
53.             num-vert (cdr (assoc 90 elist))
54.             elist    (member (assoc 10 elist) elist)
55.             vlist    nil
56.             ) ; setq
57.       (repeat num-vert
58.         (setq vlist (append vlist (list (cdr (assoc 10 elist)))) ; append
59.               ) ; setq
60.         (setq elist (cdr elist)
61.               elist (member (assoc 10 elist) elist)
62.               ) ; setq
63.         )     ; repeat
64.       vlist
65.       )       ; get-lwvlist
66.      
67.     (defun get-plvlist (en / vlist)
68.       (setq vlist nil
69.             en    (entnext en)
70.             ) ; setq
71.       (while (/= "SEQEND" (dxf 0 en))
72.         (setq vlist (append vlist (list (dxf 10 en))))
73.         (setq en (entnext en))
74.         )     ; while
75.       vlist
76.       )       ; get-plvlist
77.      
78.     (defun write-it (vlst en mode / newvlist msg3 fname)
79.       (setq newvlist (mapcar '(lambda (x) (trans x en 0)) ;_ lambda
80.                              vlst
81.                              ) ;_ mapcar
82.             msg3     "Polyline vertex file" ;FNAME    (getfiled MSG3 "" "txt" 1)
83.             f1       (open "FNAME" "w")
84.             ) ; setq
85.       (write-header)
86.       (write-vertices newvlist mode)
87.       (setq f1 (close f1))
88.       ) ;_ write-it
89.      
90.     (defun write-header (/ str)
91.       (setq str "        POLYLINE VERTEX POINTS")
92.       (write-line str f1)
93.       (setq str (strcat "  X            " "  Y            " "  Z") ;_ strcat
94.             ) ;_ setq
95.       (write-line str f1)
96.       ) ;_ write-header
97.      
98.      
99.     (defun write-vertices (newvlist mode / xstr ystr zstr str l)
100.       ;(setvar 'osmode 0)
101.       (setvar "OSMODE" 13) ; NODE,END,CENTER
102.       (progn (initget "1 2")
103.              (setq l (cond ((getkword "\nLayer1 (1)/ Layer2 (2) < 1 > :"))
104.                            ("1")
105.                            ) ;_ end of cond
106.                    ) ;_ end of setq
107.              (if (eq l "1")
108.                (command "_layer" "_m" "Layer1 text" "_c" "7" "" "")
109.                ) ;_ end of if
110.              (if (eq l "2")
111.                (command "_layer" "_m" "layer2 text" "_c" "7" "" "")
112.                ) ;_ end of if
113.              ) ;_ end of progn
114.       (setq httt (if mode
115.                    "0.35"
116.                    "1.75"
117.                    ) ;_ end of if
118.             ) ;_ end of setq
119.  
120.       (setq gptx (getpoint "\nSelect insert point for length: "))
121.       (setq gpty (getpoint "\nSelect insert point for elevetion: "))
122.       (foreach item newvlist
123.         (setq xstr (rtos (nth 0 item) 2 2)
124.               ystr (rtos (/ (nth 1 item) scf) 2 2)
125.               zstr (rtos (nth 2 item) 2 2)
126.               str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr) ;_ strcat
127.               ) ; setq
128.               ;      (write-line STR F1)
129.         ;(command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
130.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx)) httt "0" (strcat xstr))
131.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty)) httt "0" (strcat ystr))
132.         )     ; foreach
133.       )       ; write-vertices
134.      
135.      
136.     (defun spaces (str / field num char space)
137.       (setq field 15
138.             num   (- field (strlen str))
139.             char  " "
140.             space ""
141.             ) ;_ setq
142.       (repeat num (setq space (strcat space char))) ;_ repeat
143.       ) ;_ spaces
144.      
145.     (defun c:test () (setq scf 1) (setting) (vertext t) (resetting) (princ))
146.  
147.     (vl-load-com)
148.  
149.  
150.  

Thanks

[mhy3sx]

Any ideas?

Thanks

[BIGAL]

Didn't I send you the Surface Rl.lsp use that as a start.

Else invest in civil software like "Civil Site Design". It will do way more for you.

[mhy3sx]

Hi BIGAL. I can not see any Surface Rl.lsp?

Thanks

[mhy3sx]

Hi update the code

1) Add the table lines for ground2
2) Update the code to automatic insert labels without picking the position
3) Add the pick point for the datum


I need help to the length and elevation of the polyline to work correct in random position.

Code - Auto/Visual Lisp: [Select]

1.  
2.     (defun err (s)
3.       (if (= s "Function cancelled")
4.         (princ "\nVERTEXT - cancelled: ")
5.         (progn (princ "\nVERTEXT - Error: ") (princ s) (terpri))
6.         ) ;_ end of if
7.       (resetting)
8.       (princ "SYSTEM VARIABLES have been reset\n")
9.       (princ)
10.       ) ;_ end of defun
11.     (defun setv (systvar newval)
12.       (setq x (read (strcat systvar "1")))
13.       (set x (getvar systvar))
14.       (setvar systvar newval)
15.       ) ;_ end of defun
16.     (defun setting () (setq oerr *error*) (setq *error* err) (setv "CMDECHO" 0) (setv "BLIPMODE" 0))
17.     (defun rsetv (systvar) (setq x (read (strcat systvar "1"))) (setvar systvar (eval x)))
18.      
19.     (defun resetting () (rsetv "CMDECHO") (rsetv "BLIPMODE") (setq *error* oerr))
20.      
21.      
22.     (defun dxf (code ename) (cdr (assoc code (entget ename)))) ; dxf
23.      
24.     (defun vertext (mode / en vlist)
25.       (setq en (get-en))
26.       (if (= (dxf 0 en) "LWPOLYLINE")
27.         (setq vlist (get-lwvlist en))
28.         (setq vlist (get-plvlist en))
29.         ) ;_ end of if
30.       (write-it vlist en mode)
31.       ) ;_ end of defun
32.      
33.     (defun get-en (/ no-ent en msg1 msg2)
34.       (setq no-ent 1
35.             en     nil
36.             msg1   "\nselect polyline: "
37.             msg2   "\nTry again !!!."
38.             ) ; setq
39.       (while no-ent
40.         (setq en (car (entsel msg1)))
41.         (if (and en
42.                  (or (= (dxf 0 en) "LWPOLYLINE") (= (dxf 0 en) "POLYLINE")) ; or
43.                  ) ; and
44.           (progn (setq no-ent nil)) ; progn
45.           (prompt msg2)
46.           )   ; if
47.         )     ; while
48.       en
49.       )       ; get-en
50.      
51.     (defun get-lwvlist (en / elist num-vert vlist)
52.       (setq elist    (entget en)
53.             num-vert (cdr (assoc 90 elist))
54.             elist    (member (assoc 10 elist) elist)
55.             vlist    nil
56.             ) ; setq
57.       (repeat num-vert
58.         (setq vlist (append vlist (list (cdr (assoc 10 elist)))) ; append
59.               ) ; setq
60.         (setq elist (cdr elist)
61.               elist (member (assoc 10 elist) elist)
62.               ) ; setq
63.         )     ; repeat
64.       vlist
65.       )       ; get-lwvlist
66.      
67.     (defun get-plvlist (en / vlist)
68.       (setq vlist nil
69.             en    (entnext en)
70.             ) ; setq
71.       (while (/= "SEQEND" (dxf 0 en))
72.         (setq vlist (append vlist (list (dxf 10 en))))
73.         (setq en (entnext en))
74.         )     ; while
75.       vlist
76.       )       ; get-plvlist
77.      
78.     (defun write-it (vlst en mode / newvlist msg3 fname)
79.       (setq newvlist (mapcar '(lambda (x) (trans x en 0)) ;_ lambda
80.                              vlst
81.                              ) ;_ mapcar
82.             msg3     "Polyline vertex file" ;FNAME    (getfiled MSG3 "" "txt" 1)
83.             f1       (open "FNAME" "w")
84.             ) ; setq
85.       (write-header)
86.       (write-vertices newvlist mode)
87.       (setq f1 (close f1))
88.       ) ;_ write-it
89.      
90.     (defun write-header (/ str)
91.       (setq str "        POLYLINE VERTEX POINTS")
92.       (write-line str f1)
93.       (setq str (strcat "  X            " "  Y            " "  Z") ;_ strcat
94.             ) ;_ setq
95.       (write-line str f1)
96.       ) ;_ write-header
97.      
98.      
99.     (defun write-vertices (newvlist mode / xstr ystr zstr str l)
100.       (setvar 'osmode 0)
101.  
102.       (setq httt (if mode
103.                    "0.35"
104.                    "1.75"
105.                    ) ;_ end of if
106.             ) ;_ end of setq
107.   (setvar "OSMODE" 13) ; NODE,END,CENTER
108.   (setq st (getpoint "\nsELECT THE DATUM POINT :"))
109.   (setq p1 st)                                
110.   (setq p2 (list (+ (car st) le_1) (cadr st)))
111.   (setq p9 (list (car st) (- (cadr st) 6.0)))
112.   (setq p10 (list (car p2) (- (cadr p2) 6.0)))
113.   (setq p3 (list (car st) (- (cadr st) 7.2)))
114.   (setq p4 (list (car p2) (- (cadr p2) 7.2)))
115.   (setq p11 (list (car p3) (- (cadr p3) 1.2)))
116.   (setq p12 (list (car p4) (- (cadr p4) 1.2)))
117.   (setq p5 (list (car p3) (- (cadr p3) 2.4)))
118.   (setq p6 (list (car p4) (- (cadr p4) 2.4)))
119.   (setq p7 (list (car p1) (- (cadr p1) 6.0)))
120.   (setq p8 (list (car p1) (- (cadr p1) 8.40)))
121.   (command "layer" "_m" "table" "color" "7" "" "")
122.   (command "line" st p2 "")
123.   (command "line" p3 p4 "")
124.   (command "line" p5 p6 "")
125.   (command "layer" "_m" "FRAME" "color" "8" "" "_plot" "_no" "" "")
126.   (command "line" p9 p10 "")
127.   (command "line" p11 p12 "")
128.   (command "_layer" "_m" "Layer1 text" "_c" "7" "" "")
129.   (setq gptx p11)
130.   (setq gpty p9)
131.  
132.       (foreach item newvlist
133.         (setq xstr (rtos (nth 0 item) 2 2)
134.               ystr (rtos (/ (nth 1 item) scf) 2 2)
135.               zstr (rtos (nth 2 item) 2 2)
136.               str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr) ;_ strcat
137.               ) ; setq
138.               ;      (write-line STR F1)
139.                 (setvar "OSMODE" 0)
140.         (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
141.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx)) httt "0" (strcat xstr))
142.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty)) httt "0" (strcat ystr))
143.         )     ; foreach
144.       )       ; write-vertices
145.      
146.      
147.     (defun spaces (str / field num char space)
148.       (setq field 15
149.             num   (- field (strlen str))
150.             char  " "
151.             space ""
152.             ) ;_ setq
153.       (repeat num (setq space (strcat space char))) ;_ repeat
154.       ) ;_ spaces
155.      
156.     (defun c:test () (setq scf 1) (setting) (vertext t) (resetting) (princ))
157.  
158.     (vl-load-com)
159.  
160.  
161.  

Thanks

[mhy3sx]

Any Ideas?

Thanks

[BIGAL]

Surface RL

[mhy3sx]

Hi BIGAL thanks for the RL.lsp but is not what I am looking for.

Can any one help me to fix this code

Code - Auto/Visual Lisp: [Select]

1.  (defun err (s)
2.       (if (= s "Function cancelled")
3.         (princ "\nVERTEXT - cancelled: ")
4.         (progn (princ "\nVERTEXT - Error: ") (princ s) (terpri))
5.         ) ;_ end of if
6.       (resetting)
7.       (princ "SYSTEM VARIABLES have been reset\n")
8.       (princ)
9.       ) ;_ end of defun
10.     (defun setv (systvar newval)
11.       (setq x (read (strcat systvar "1")))
12.       (set x (getvar systvar))
13.       (setvar systvar newval)
14.       ) ;_ end of defun
15.     (defun setting () (setq oerr *error*) (setq *error* err) (setv "CMDECHO" 0) (setv "BLIPMODE" 0))
16.     (defun rsetv (systvar) (setq x (read (strcat systvar "1"))) (setvar systvar (eval x)))
17.      
18.     (defun resetting () (rsetv "CMDECHO") (rsetv "BLIPMODE") (setq *error* oerr))
19.      
20.      
21.     (defun dxf (code ename) (cdr (assoc code (entget ename)))) ; dxf
22.      
23.     (defun vertext (mode / en vlist)
24.       (setq en (get-en))
25.       (if (= (dxf 0 en) "LWPOLYLINE")
26.         (setq vlist (get-lwvlist en))
27.         (setq vlist (get-plvlist en))
28.         ) ;_ end of if
29.       (write-it vlist en mode)
30.       ) ;_ end of defun
31.      
32.     (defun get-en (/ no-ent en msg1 msg2)
33.       (setq no-ent 1
34.             en     nil
35.             msg1   "\nselect polyline: "
36.             msg2   "\nTry again !!!."
37.             ) ; setq
38.       (while no-ent
39.         (setq en (car (entsel msg1)))
40.         (if (and en
41.                  (or (= (dxf 0 en) "LWPOLYLINE") (= (dxf 0 en) "POLYLINE")) ; or
42.                  ) ; and
43.           (progn (setq no-ent nil)) ; progn
44.           (prompt msg2)
45.           )   ; if
46.         )     ; while
47.       en
48.       )       ; get-en
49.      
50.     (defun get-lwvlist (en / elist num-vert vlist)
51.       (setq elist    (entget en)
52.             num-vert (cdr (assoc 90 elist))
53.             elist    (member (assoc 10 elist) elist)
54.             vlist    nil
55.             ) ; setq
56.       (repeat num-vert
57.         (setq vlist (append vlist (list (cdr (assoc 10 elist)))) ; append
58.               ) ; setq
59.         (setq elist (cdr elist)
60.               elist (member (assoc 10 elist) elist)
61.               ) ; setq
62.         )     ; repeat
63.       vlist
64.       )       ; get-lwvlist
65.      
66.     (defun get-plvlist (en / vlist)
67.       (setq vlist nil
68.             en    (entnext en)
69.             ) ; setq
70.       (while (/= "SEQEND" (dxf 0 en))
71.         (setq vlist (append vlist (list (dxf 10 en))))
72.         (setq en (entnext en))
73.         )     ; while
74.       vlist
75.       )       ; get-plvlist
76.      
77.     (defun write-it (vlst en mode / newvlist msg3 fname)
78.       (setq newvlist (mapcar '(lambda (x) (trans x en 0)) ;_ lambda
79.                              vlst
80.                              ) ;_ mapcar
81.             msg3     "Polyline vertex file" ;FNAME    (getfiled MSG3 "" "txt" 1)
82.             f1       (open "FNAME" "w")
83.             ) ; setq
84.       (write-header)
85.       (write-vertices newvlist mode)
86.       (setq f1 (close f1))
87.       ) ;_ write-it
88.      
89.     (defun write-header (/ str)
90.       (setq str "        POLYLINE VERTEX POINTS")
91.       (write-line str f1)
92.       (setq str (strcat "  X            " "  Y            " "  Z") ;_ strcat
93.             ) ;_ setq
94.       (write-line str f1)
95.       ) ;_ write-header
96.      
97.      
98.     (defun write-vertices (newvlist mode / xstr ystr zstr str l)
99.       (setvar 'osmode 0)
100.  
101.       (setq httt (if mode
102.                    "0.35"
103.                    "1.75"
104.                    ) ;_ end of if
105.             ) ;_ end of setq
106.   (setvar "OSMODE" 13) ; NODE,END,CENTER
107.   (setq st (getpoint "\nsELECT THE DATUM POINT :"))
108.   (setq p1 st)                                
109.   (setq p2 (list (car st) (cadr st)))
110.   (setq p9 (list (car st) (- (cadr st) 6.0)))
111.   (setq p10 (list (car p2) (- (cadr p2) 6.0)))
112.   (setq p3 (list (car st) (- (cadr st) 7.2)))
113.   (setq p4 (list (car p2) (- (cadr p2) 7.2)))
114.   (setq p11 (list (car p3) (- (cadr p3) 1.2)))
115.   (setq p12 (list (car p4) (- (cadr p4) 1.2)))
116.   (setq p5 (list (car p3) (- (cadr p3) 2.4)))
117.   (setq p6 (list (car p4) (- (cadr p4) 2.4)))
118.   (setq p7 (list (car p1) (- (cadr p1) 6.0)))
119.   (setq p8 (list (car p1) (- (cadr p1) 8.40)))
120.   (command "layer" "_m" "table" "color" "7" "" "")
121.   (command "line" st p2 "")
122.   (command "line" p3 p4 "")
123.   (command "line" p5 p6 "")
124.   (command "layer" "_m" "FRAME" "color" "8" "" "_plot" "_no" "" "")
125.   (command "line" p9 p10 "")
126.   (command "line" p11 p12 "")
127.   (command "_layer" "_m" "Layer1 text" "_c" "7" "" "")
128.   (setq gptx p11)
129.   (setq gpty p9)
130.  
131.       (foreach item newvlist
132.         (setq xstr (rtos (nth 0 item) 2 2)
133.               ystr (rtos (/ (nth 1 item) scf) 2 2)
134.               zstr (rtos (nth 2 item) 2 2)
135.               str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr) ;_ strcat
136.               ) ; setq
137.               ;      (write-line STR F1)
138.                 (setvar "OSMODE" 0)
139.         (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
140.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx)) httt "0" (strcat xstr))
141.         (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty)) httt "0" (strcat ystr))
142.         )     ; foreach
143.       )       ; write-vertices
144.      
145.      
146.     (defun spaces (str / field num char space)
147.       (setq field 15
148.             num   (- field (strlen str))
149.             char  " "
150.             space ""
151.             ) ;_ setq
152.       (repeat num (setq space (strcat space char))) ;_ repeat
153.       ) ;_ spaces
154.      
155.     (defun c:test () (setq scf 1) (setting) (vertext t) (resetting) (princ))
156.  
157.     (vl-load-com)
158.  
159.  
160.  

Thanks

[mhy3sx]

Can anyone fix the code?

Thanks