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

[draconian_acts]

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.

[CodeDing]

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

Please add this to OP's request.

Best,

~DD

[draconian_acts]

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.

[pendean]

---

@draconian_acts wrote:

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

---

Never heard of it before, must try it now

[Sea-Haven]

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.

[calderg1000 · 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)
)

 

[draconian_acts]

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

[draconian_acts]

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

[draconian_acts]

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")

[calderg1000]

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)
  )
)

[draconian_acts]

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")

[calderg1000]

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 . "*"))))

[draconian_acts]

(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.