Lisp to insert points along polyline at endpoints & midpoints

[Quango1]

Hi,

 

I've been looking for a while for the solutions to this and haven't come across one yet.

is there a lisp routine that will automatically places points at every endpoint and midpoint of a polyline?

 

I know C3D has an option to do this for just the endpoints but not aware if there is one for both mid and endpoints.

 

Thanks,

[mhupp]

Should be what your looking for.

 

(defun C:PP (/ SS vla SPT MPT EPT)
  (prompt "\nSelect Polylines")
  (if (setq SS (ssget '((0 . "*POLYLINE"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq vla (vlax-ename->vla-object poly)
            SPT (vlax-curve-getStartPoint vla)
            MPT (vlax-curve-getPointAtDist vla (/ (vlax-get-property vla 'length) 2.0))
            EPT (vlax-curve-getendpoint vla)
      )
      (entmake (list '(0 . "POINT") (cons 10 SPT)))
      (entmake (list '(0 . "POINT") (cons 10 MPT)))
      (entmake (list '(0 . "POINT") (cons 10 EPT)))
    )
  )
  (princ)
)

 

Edited February 7, 2022 by mhupp
dang princ

[Tharwat]

Another way to approach the same goal.

(defun c:Test ( / sel int ent get )
  ;; Tharwat - 8.Feb.2022	;;
  (and (princ "\nSelect polylines to locate points on end points and center : ")
       (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq get (entget ent))
         (foreach pt (list (cdr (assoc 10 get))
                           (cdr (assoc 10 (reverse get)))
                           (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent
                                                               (vlax-curve-getendpoint ent)) 2.0)))
           (entmake (list '(0 . "POINT") (cons 10 pt)))
           )
         )
       )
  (princ)
  ) (vl-load-com)

 

[Quango1]

Thanks for getting back to me, I think I misworded what I needed the lisp to do.

 

is it possible for the points to be placed at every node on the polyline as well as the midpoint between the vertices? 

For example:

[hosneyalaa]

18 hours ago, Quango1 said:

 

I know C3D has an option to do this for just the endpoints but not aware if there is one for both mid and endpoints.

 

Hi
Which version C3D  are you working on?

[Quango1]

Hi,

 

C3D 2022

[hosneyalaa]

try this

 

[Steven P]

Try this, 

 

It works by drawing temporary plines each 1 element of your selection, and using Tharwats code to plot points at their end and mid points.

 

EDITED... it adds multiple points at the end of each vertex, just need to do a small modification later

 

Apparently Tuesdays I have to work as well as Monday, who knew? Will come back to look at this later

 

 

(defun c:test ( / endpoint curve midpoints ss acount mycount ent entdesc pt)
  (vl-load-com)
;;Get verticies, Points: 10 and Curve: 42
  (princ "\nSelect polylines : ")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (setq acount 0)
  (while (< acount (sslength ss))
    (setq endpoint (list))
    (setq curve (list))
    (setq ent (ssname ss acount))
    (setq entdesc (entget ent))

    (foreach x entdesc
      (if (= (car x) 10) (setq endpoint (append endpoint (list (cdr x)))) )
      (if (= (car x) 42) (setq curve (append curve (list (cdr x)))) )
    )

;;Make temporary plines & get mid points
    (setq mycount 1)
    (while (< mycount (length endpoint))
      (entmake (list (cons 0 "LWPOLYLINE")
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbPolyline")
                 (cons 90 2)
                 (cons 70 0)
                 (cons 10 (nth (- mycount 1) endpoint))
                 (cons 42 (nth (- mycount 1) curve))
                 (cons 10 (nth mycount endpoint))
      )) ;;end entmake
      (setq ent (entlast))
      (setq get (entget ent))

;;From Tharwart
      (foreach pt (list (cdr (assoc 10 get))
        (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.0)))
        (entmake (list '(0 . "POINT") (cons 10 pt)))
      ) ;end for each

      (entdel ent) ;;delete temp pline
      (setq mycount (+ mycount 1))
    ) ; end while

    (entmake (list '(0 . "POINT") (cons 10 (last endpoint))))
    (setq acount (+ acount 1))
  ) ; end while
  (princ)
)

 

Edited February 8, 2022 by Steven P

[Tharwat]

I think this should be enough. < untested >.  

(defun c:Test ( / sel int ent get inc)
  ;;----------------------------------------------------;;
  ;; Author : Tharwat Al Choufi	- 8.Feb.2022		;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect polylines to locate points on end and mid points : ")
       (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq get (entget ent)
               inc -1
               )
         (foreach pt get
           (and (= (car pt) 10)
                (setq inc (1+ inc))
                (foreach ins (list (vlax-curve-getpointatparam ent inc)
                                   (vlax-curve-getpointatparam ent (- inc 0.5))
                                   )
                  (and ins (entmake (list '(0 . "POINT") (cons 10 ins))))
                  )
                )
           )
         )
       )
  (princ)
  ) (vl-load-com)

 

[Quango1]

Thanks for the help!!

 

Both work perfectly!!

[hosneyalaa]

 

 

This can be done with dynamo in a simpler and more free manner

 

 

Edited February 9, 2022 by hosneyalaa
tt

[devitg]

What DYNAMO stand for ??

[mhupp]

20 minutes ago, devitg said:

What DYNAMO stand for ??

 

DYNAMO looks to be an addon

[hosneyalaa]

1 hour ago, devitg said:

What DYNAMO stand for ??

Dynamo is an addon program in addition to Civil 3D It works fun and free to change In the code with better results

 Uses Api or com api for cad or civil 3d 

[mhupp]

On 2/8/2022 at 10:29 AM, Steven P said:

It works by drawing temporary plines each 1 element of your selection, and using Tharwats code to plot points at their end and mid points.

 

@Steven P When I read this it reminded me of something i came across in visual lisp. the funcion vlax-invoke with 'explode does explode the selected item into individual entity's. but it also leaves the original too. this builds off that and takes the start point and mid point of each entity. Then deletes them leaving only the original polyline and points.

 

2 problems arc's starting point seems to be depended of something other then the polyline direction.

   And if you select an open polyline the end pt isn't created.

 

Uses thwarts point creation

(defun C:Foo (/ SS)
  (vl-load-com)
  (princ "\nSelect polylines : ")
  (setq SS (ssget '((0 . "LWPOLYLINE"))))
  (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (setq poly (vlax-invoke (vlax-ename->vla-object e) 'explode))
    (foreach ent poly
      (foreach pt (list (vlax-curve-getStartPoint ent) ;Tharwat
                  (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.00)))
          (entmake (list '(0 . "POINT") (cons 10 pt)))
      ) ;end foreach
      (vla-delete ent)
    )   ;end foreach
  )     ;end foreach
  (princ)
)

[ronjonp]

Another:

(defun c:foo (/ n p s)
  (if (setq s (ssget '((0 . "LWPOLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq n 0)
      (while (setq p (vlax-curve-getpointatparam e n))
	(entmakex (list '(0 . "POINT") (cons 10 p)))
	(setq n (+ n 0.5))
      )
    )
  )
  (princ)
)

 

Edited February 10, 2022 by ronjonp

[Tomh111]

On 08/02/2022 at 16:56, Tharwat said:

I think this should be enough. < untested >.  

(defun c:Test ( / sel int ent get inc)
  ;;----------------------------------------------------;;
  ;; Author : Tharwat Al Choufi	- 8.Feb.2022		;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect polylines to locate points on end and mid points : ")
       (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq get (entget ent)
               inc -1
               )
         (foreach pt get
           (and (= (car pt) 10)
                (setq inc (1+ inc))
                (foreach ins (list (vlax-curve-getpointatparam ent inc)
                                   (vlax-curve-getpointatparam ent (- inc 0.5))
                                   )
                  (and ins (entmake (list '(0 . "POINT") (cons 10 ins))))
                  )
                )
           )
         )
       )
  (princ)
  ) (vl-load-com)

 

Hi,

 

This is great and will save me a lot of time, i am very new to lisps and coding etc, how would someone modify the above to only put points at the endpoints and not midpoints?

 

Thanks very much.

 

Tom

[Tharwat]

9 hours ago, Tomh111 said:

Hi,

 

This is great and will save me a lot of time, i am very new to lisps and coding etc, how would someone modify the above to only put points at the endpoints and not midpoints?

 

Thanks very much.

 

Tom

Glad to hear that.  

Here is the modified codes for you to work only with the original vertices of selected polylines.

(defun c:Test (/ sel int ent get)
  ;;----------------------------------------------------;;
  ;; Author : Tharwat Al Choufi	- 8.Feb.2022		;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect polylines to locate points on vertices : ")
       (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       (or (not (zerop (getvar 'PDMODE))) (setvar 'PDMODE 3))
       (while (setq int (1+ int)
                    ent (ssname sel int)
              )
         (setq get (entget ent))
         (foreach pt get
           (and (= (car pt) 10)
                (entmake (list '(0 . "POINT") pt))
           )
         )
       )
  )
  (princ)
)

 

[PabloS]

Hello @Tharwat

 

Would you mind helping me with a similar but complex problem? I need to add small lines (45º angle relative to polyline) only on outwards vertex of polylines like this:

 

 

Also if selected object is a circle I need to add 4 small lines in 45º angle like this:

 

Hope you can help me here!

 

Regards,

Pablo

[Tharwat]

Hello, to add these oriented 45 deg. lines is simple on circles but on polylines needs more codes with entirely different approach. 

Sorry I am busy at the meantime.