Community

I need a lisp routine to draw a polyline over existing design

I need a lisp routine to draw a polyline over existing design

draconian_acts
Enthusiast Enthusiast
1,102 Views
12 Replies
Message 1 of 13

I need a lisp routine to draw a polyline over existing design

draconian_acts
Enthusiast
Enthusiast
‎10-25-2024 12:01 PM

I need a Lisp routine that can draw a design polyline over a Roadway X-Section, starting from the side cut or, if there's an embankment, from the beginning of the embankment slope, and then following the lowest subgrade line. I need this routine to easily find cut and fill areas. Doing this manually only takes a few clicks, but sometimes we have a large number of cross-sections to process. I've attached an example drawing to help explain the requirements for the Lisp.

Sample.dwg
0 Likes
Like
Report
Accepted solutions (1)
Solution 1
1,103 Views
12 Replies
Replies (12)
Message 2 of 13

CodeDing
Advisor
Advisor
‎10-25-2024 12:29 PM

I need a lisp routine that will process a topographic survey from start to finish.

Please add this to OP's request.

 

Best,

~DD

0 Likes
Like
Report
Message 3 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to CodeDing
‎10-25-2024 12:33 PM

Bro , Install SW DTM it's free and besides that you can import points from excel with a single click , all you need is to select the point northing easting description range in excel and click import then it's gonna import , besides that you can triangulate and make contour with a single click.

try SW DTM there are so many tutorials on youtube.

0 Likes
Like
Report
Message 4 of 13

pendean
Community Legend
Community Legend
in reply to draconian_acts
‎10-25-2024 01:49 PM
@draconian_acts wrote:

Bro , Install SW DTM it's free ....

Never heard of it before, must try it now

pendean_0-1729889375565.png

 

Report
Message 5 of 13

Sea-Haven
Mentor
Mentor
‎10-26-2024 08:20 PM

As I suggested elsewhere a full functioning Civil package is the way to go, what about the other 103 options you need. Will they start tomorrow ?

 

Civil Site Design.

Report
Message 6 of 13

calderg1000
Mentor
Mentor
‎10-27-2024 05:46 PM
Accepted solution

Regards @draconian_acts 

Try this code
Previously hiding the interfering elements, it improves the layout of the sections, extending the subgrade lines to the slope line.

 

;;;___
(defun c:S_ras (/ s p1 p2 p3 px1 px2 ldat epol p spb)
  (while (and
           (setq p1 (getpoint "\nPick Point 1 : ")
                 p2 (getpoint p1 "\nPick Point 2 : ")
                 p3 (getpoint p2 "\nPick Point 3 : ")
           )
         )
    (setq
      px1  (list (car p1) (cadr p3))
      px2  (list (car p2) (cadr p3))
      ldat (list px1 px2)
    )
    ;;Lwpolyline previa
    (entmakex (append (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            (cons 90 4)
                      )
                      (mapcar
                        '(lambda (j) (cons 10 j))
                        (list p1 px1 px2 p2)
                      )
              )
    )
    (setq epol (entlast))
    ;;Creacion de Polilinea con Boundary
    (setq p (mapcar '+ p3 '(0 0.5 0)))
    (command "_.boundary" "_non" p "")
    (command "_.erase" epol "")
    ;;Remueve puntos de la base en Polilinea Boundary
    (setq spb (entget (entlast)))
    (foreach x ldat
      (setq spb
             (vl-remove-if '(lambda (n) (equal (cons 10 x) n 0.01)) spb)
      )
    )
    (entmod (append spb (list (cons 62 1))))
    (entmod (subst (cons 70 0) (assoc 70 spb) spb))
  )
 (princ)
)

 

 

Sub_Rasante.gif

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

Report
Message 7 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to calderg1000
‎10-28-2024 12:22 AM

Brother , i tried your lisp routine over my drawing but it's not working properly here , it traces the wrong way the line gets mixed up with the NSL line , could you please make changes according to this drawing or let me know what changes do i make in this drawing to make the lisp routine work for me.

please apply this lisp routine on this drawing and let me know why is it not working on my drawing. Thanks

Sample.dwg
0 Likes
Like
Report
Message 8 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to calderg1000
‎10-28-2024 12:37 AM

Bro , I checked it again and it works fine now , the only mistake i was doing i didn't check one of the corner line was not extended , i joined them and it works fine now. Thanks

Report
Message 9 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to calderg1000
‎10-28-2024 08:40 AM

Bro i made some changes in the lisp routine , now it works only when i turn of the pgl layer , it prompts to select an object on the targeted layer , but i think it needs further changes , kindly check the lisp and the attached .dwg file. Thanks

 

(defun c:Tdsn (/ s p1 p2 p3 px1 px2 ldat epol p spb layer)
;; Prompt to select an object on the desired layer
(prompt "\nSelect an object on the target layer: ")
(setq s (ssget ":E" '((0 . "*"))))
(if s
(setq layer (cdr (assoc 8 (entget (ssname s 0)))))
(prompt "\nNo object selected."))
;; Proceed if a layer is selected
(if layer
(progn
(while (and
(setq p1 (getpoint "\nPick Point 1 : ")
p2 (getpoint p1 "\nPick Point 2 : ")
p3 (getpoint p2 "\nPick Point 3 : "))
)
(setq
px1 (list (car p1) (cadr p3))
px2 (list (car p2) (cadr p3))
ldat (list px1 px2))
;; Lwpolyline previa
(entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 4))
(mapcar
'(lambda (j) (cons 10 j))
(list p1 px1 px2 p2))))
(setq epol (entlast))
;; Creacion de Polilinea con Boundary
(setq p (mapcar '+ p3 '(0 0.5 0)))
(command "_.boundary" "_non" p "")
(command "_.erase" epol "")
;; Remueve puntos de la base en Polilinea Boundary
(setq spb (entget (entlast)))
(foreach x ldat
(setq spb
(vl-remove-if '(lambda (n) (equal (cons 10 x) n 0.01)) spb)))
(entmod (append spb (list (cons 62 1))))
(entmod (subst (cons 70 0) (assoc 70 spb) spb)))
;; Filter objects by layer
(setq s (ssget "X" (list (cons 8 layer) (cons 0 "LINE,POLYLINE,INSERT"))))
(while (setq p (ssname s 0))
;; Process the object based on type
(setq type (cdr (assoc 0 (entget p))))
(cond
((= type "LINE")
;; Process line object
)
((= type "LWPOLYLINE")
;; Process polyline object
)
((= type "INSERT")
;; Process block object
))
(ssdel p s)))
(prompt "\nNo layer selected."))

(princ))

(princ "TDSN command loaded.\n")

TDSN.dwg
0 Likes
Like
Report
Message 10 of 13

calderg1000
Mentor
Mentor
in reply to draconian_acts
‎10-28-2024 01:37 PM

Regards @draconian_acts 

I don't quite understand what you're trying to do, but I assume you want to select an object and apply its layer property to the required polyline.

Try this code, 

;;;___
(defun c:S_ras (/ s p1 p2 p3 px1 px2 ldat epol p spb layer)
  (setq s     (ssget "+.:E:S" '((0 . "*")))
        layer (cdr (assoc 8 (entget (ssname s 0))))
  )
  (while (and
           (setq p1 (getpoint "\nPick Point 1 : ")
                 p2 (getpoint p1 "\nPick Point 2 : ")
                 p3 (getpoint p2 "\nPick Point 3 : ")
           )
         )
    (setq
      px1  (list (car p1) (cadr p3))
      px2  (list (car p2) (cadr p3))
      ldat (list px1 px2)
    )
    ;;Lwpolyline previa
    (entmakex (append (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            (cons 90 4)
                      )
                      (mapcar
                        '(lambda (j) (cons 10 j))
                        (list p1 px1 px2 p2)
                      )
              )
    )
    (setq epol (entlast))
    ;;Creacion de Polilinea con Boundary
    (setq p (mapcar '+ p3 '(0 0.5 0)))
    (command "_.boundary" "_non" p "")
    (command "_.erase" epol "")
    ;;Remueve puntos de la base en Polilinea Boundary
    (setq spb (entget (entlast)))
    (foreach x ldat
      (setq spb
             (vl-remove-if '(lambda (n) (equal (cons 10 x) n 0.01)) spb)
      )
    )
    (setq spb (append spb (list (cons 8 layer) (cons 62 1))))
    (entmod (subst (cons 70 0) (assoc 70 spb) spb))
    (princ)
  )
)

Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Like
Report
Message 11 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to calderg1000
‎10-28-2024 01:38 PM

I think this one is final version , there is no need to turn off layers manually and applying command , it's fully automatic , check this one 

(defun c:Tdsn (/ s p1 p2 p3 px1 px2 ldat epol p spb layer all-layers)
  ;; Get the names of all layers
  (setq all-layers (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))

  ;; Prompt to select an object on the desired layer
  (prompt "\nSelect a single object on the target layer: ")
  (setq s (ssget ":E" '((0 . "*"))))
  (if s
    (progn
      (setq layer (cdr (assoc 8 (entget (ssname s 0)))))
      (prompt "\nSelection successful!")
      ;; Turn off all other layers
      (vlax-for lay all-layers
        (if (/= (vla-get-Name lay) layer)
          (vla-put-LayerOn lay :vlax-false)))
      ;; Proceed with point selection
      (if (and
            (setq p1 (getpoint "\nPick Point 1 : "))
            (setq p2 (getpoint p1 "\nPick Point 2 : "))
            (setq p3 (getpoint p2 "\nPick Point 3 : ")))
        (progn
          (setq
            px1  (list (car p1) (cadr p3))
            px2  (list (car p2) (cadr p3))
            ldat (list px1 px2))
          ;; Lwpolyline previa
          (entmakex (append (list '(0 . "LWPOLYLINE")
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbPolyline")
                                  (cons 90 4))
                            (mapcar
                              '(lambda (j) (cons 10 j))
                              (list p1 px1 px2 p2))))
          (setq epol (entlast))
          ;; Creacion de Polilinea con Boundary
          (setq p (mapcar '+ p3 '(0 0.5 0)))
          (command "_.boundary" "_non" p "")
          (command "_.erase" epol "")
          ;; Remueve puntos de la base en Polilinea Boundary
          (setq spb (entget (entlast)))
          (foreach x ldat
            (setq spb
                  (vl-remove-if '(lambda (n) (equal (cons 10 x) n 0.01)) spb)))
          (entmod (append spb (list (cons 62 1))))
          (entmod (subst (cons 70 0) (assoc 70 spb) spb))))
      ;; Turn on all layers again
      (vlax-for lay all-layers
        (vla-put-LayerOn lay :vlax-true))))
  (prompt "\nNo object selected."))

(princ "TDSN command loaded.\n")
TDSN.dwg
0 Likes
Like
Report
Message 12 of 13

calderg1000
Mentor
Mentor
in reply to draconian_acts
‎10-28-2024 04:01 PM

Regards @draconian_acts 

I liked it, to optimize a little more, you can make a small change in this line:

(setq s (ssget "+.:E:S" '((0 . "*"))))

 

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

Report
Message 13 of 13

draconian_acts
Enthusiast
Enthusiast
in reply to calderg1000
‎10-28-2024 10:55 PM 
(defun c:Tdsn (/ s p1 p2 p3 px1 px2 ldat epol p spb layer all-layers)
  ;; Get the names of all layers
  (setq all-layers (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))

  ;; Prompt to select an object on the desired layer
  (prompt "\nSelect a single object on the target layer: ")
  (setq s (ssget "+.:E:S" '((0 . "*"))))
  (if s
    (progn
      (setq layer (cdr (assoc 8 (entget (ssname s 0)))))
      (prompt "\nSelection successful!")
      ;; Turn off all other layers
      (vlax-for lay all-layers
        (if (/= (vla-get-Name lay) layer)
          (vla-put-LayerOn lay :vlax-false)))
      ;; Proceed with point selection
      (if (and
            (setq p1 (getpoint "\nPick Point 1 : "))
            (setq p2 (getpoint p1 "\nPick Point 2 : "))
            (setq p3 (getpoint p2 "\nPick Point 3 : ")))
        (progn
          (setq
            px1  (list (car p1) (cadr p3))
            px2  (list (car p2) (cadr p3))
            ldat (list px1 px2))
          ;; Lwpolyline previa
          (entmakex (append (list '(0 . "LWPOLYLINE")
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbPolyline")
                                  (cons 90 4))
                            (mapcar
                              '(lambda (j) (cons 10 j))
                              (list p1 px1 px2 p2))))
          (setq epol (entlast))
          ;; Creacion de Polilinea con Boundary
          (setq p (mapcar '+ p3 '(0 0.5 0)))
          (command "_.boundary" "_non" p "")
          (command "_.erase" epol "")
          ;; Remueve puntos de la base en Polilinea Boundary
          (setq spb (entget (entlast)))
          (foreach x ldat
            (setq spb
                  (vl-remove-if '(lambda (n) (equal (cons 10 x) n 0.01)) spb)))
          (entmod (append spb (list (cons 62 1))))
          (entmod (subst (cons 70 0) (assoc 70 spb) spb))))
      ;; Turn on all layers again
      (vlax-for lay all-layers
        (vla-put-LayerOn lay :vlax-true))))
  (prompt "\nNo object selected."))

(princ "TDSN command loaded.\n")

I've added the line you mentioned in the Lisp routine, and now it's absolutely perfect.

Report
Report a website issue