Author Topic: Help to update a Dimension polyline lisp  (Read 1978 times)

0 Members and 1 Guest are viewing this topic.

mhy3sx

  • Newt
  • Posts: 106
Help to update a Dimension polyline lisp
« on: November 20, 2023, 06:19:05 AM »
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

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #1 on: November 21, 2023, 03:08:28 AM »
Any ideas?

Thanks

BIGAL

  • Swamp Rat
  • Posts: 1386
  • 40 + years of using Autocad
Re: Help to update a Dimension polyline lisp
« Reply #2 on: November 21, 2023, 08:03:13 PM »
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.
A man who never made a mistake never made anything

mhy3sx

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #3 on: November 22, 2023, 03:02:12 AM »
Hi BIGAL. I can not see any Surface Rl.lsp?

Thanks

mhy3sx

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #4 on: November 22, 2023, 11:51:27 AM »
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

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #5 on: November 23, 2023, 01:29:58 AM »
Any Ideas?

Thanks

BIGAL

  • Swamp Rat
  • Posts: 1386
  • 40 + years of using Autocad
Re: Help to update a Dimension polyline lisp
« Reply #6 on: November 23, 2023, 05:51:12 PM »
Surface RL
A man who never made a mistake never made anything

mhy3sx

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #7 on: November 24, 2023, 06:16:57 AM »
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

  • Newt
  • Posts: 106
Re: Help to update a Dimension polyline lisp
« Reply #8 on: November 27, 2023, 11:04:05 AM »
Can anyone fix the code?

Thanks