Auto Draw Polyline

October 7, 2011

Hello All!

I created this routine here recently and would like to share it the rest of you!

So far I have it working with ACAD Points and have a seperate copy working with Civil 3D Points.

 
;Created by B. Hippe
;October 2011
;Select points you wish to snap to.
;Click button to start.
;Hover mouse over the selected points in the order you wish to have them drawn.
[color="red"](vl-load-com)[/color]
(defun c:AutoPL ()
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (princ "\nSelect Point Objects:")
 (setq ss (ssget '(( 0 . "POINT"))))
 (setq sslen (sslength ss))
 (setq drawn nil)
 (setq junk (getpoint "\nClick to Start:"))
 (setq done nil)
 (while
   (and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
   (setq ep (is_nearest ss (nth 1 pnt)))
   (cond
     ((= drawn nil)(progn
       (setq drawn (list (car ep)))
       (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
     ((= (length drawn) 1)(if (not (is_drawn (car ep)))
       (progn
         (setq drawn (cons (car ep) drawn))
         (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     ((>= (length drawn) 2)(if (not (is_drawn (car ep)))
        (progn
   (setq drawn (cons (car ep) drawn))
   (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     )
   (if (= sslen (length drawn))
     (setq done T))
   )
 (setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist))))
 (princ)
 )

;Returns a list (entity . distance) of the closest entity (point) to the givin point
;Closest being the 2D distance
(defun is_nearest (ss opnt)
 (setq ss-len (sslength ss))
 (setq li '(0))
 (setq n 0)
 (repeat ss-len
   (setq ent (ssname ss n))
   (setq pnt (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) 'Coordinates))))
   (setq dist (distance (list (nth 0 opnt)(nth 1 opnt))(list (nth 0 pnt)(nth 1 pnt))))
   (setq pair (cons ent dist))
   (setq li (cons pair li))
   (setq n (1+ n))
   )
 (setq li (cdr (reverse li)))
 (setq li (vl-sort li (function (lambda (x y) (< (cdr x)(cdr y))))))
 (setq near-pair (nth 0 li))
 )
;graphically draws an X at a givin point
(defun drx (ctr)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 20))
 (setq xs2 (/ xs 2))
 (setq cor1 (polar ctr (* pi 0.25) xs2))
 (setq cor2 (polar ctr (* pi 0.75) xs2))
 (setq cor3 (polar ctr (* pi 1.25) xs2))
 (setq cor4 (polar ctr (* pi 1.75) xs2))
 (grdraw ctr cor1 2 0)
 (grdraw ctr cor2 2 0)
 (grdraw ctr cor3 2 0)
 (grdraw ctr cor4 2 0)
 )

;Determines if a givin entity is a member of the "drawn" list
(defun is_drawn (ent)
 (/= nil (member ent drawn)))

;create a list of coordinates for each entity in the list "drawn"
(defun drawn->pntlist ()
 (setq plist (mapcar '(lambda (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object ent) 'Coordinates)))) drawn))
 (setq li '("x"))
 (setq n 0)
 (repeat (length plist)
   (setq p (nth n plist))
   (setq li (cons (nth 2 p) li))
   (setq li (cons (nth 1 p) li))
   (setq li (cons (nth 0 p) li))
   (setq n (1+ n))
   )
 (setq li (reverse (cdr (reverse li))))
 )

;Givin a point list returns the list in variant form
(defun PL->VAR ( pl / pl ub sa var)
 (setq ub (- (length [color=red]pl[/color]) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )

*Please note that I do not include any error trapping. I am thinking that this routine could be improved on, add features, error trapping and what not. Open to ideas, comments and criticism. (And if someone wanted to create one of those cool animations of this command in progress. That would be super cool as well!)

regards,

Hippe013

Edited January 6, 2014 by Hippe013
Edit Code (See Red)

October 7, 2011

try:

(setq obj (vlax-ename->vla-object (car (entsel "\nSelect a polyline: "))))
(vlax-get obj 'Coordinates)

please add (vl-load-com)

October 7, 2011

What's if the user missed selecting the entity ??

October 7, 2011

try:

(setq obj (vlax-ename->vla-object (car (entsel "\nSelect a polyline: "))))
(vlax-get obj 'Coordinates)

Um... Have you tried the code yet?

I created this for drawing a polyline from point to point. It can get to be tedious to click point to point for several hundred points. This code allows you to just select the points you wish to snap to and then just simply hover over them.

But I do appreciate your input though

regards

October 7, 2011

What's if the user missed selecting the entity ??

Hmmm... ??? Well, what would you suggest?

I suppose as for now just take another sip of coffee and give the command another go.

Are you thinking being able to add points to the selection set in mid command?

October 7, 2011

Hmmm... ??? Well, what would you suggest?

I was indicating to Dan's post which would crash the routine if the user selected nothing ( nil ) .

and you'd better to localize your variables to avoid your codes going somewhere else when invoking the codes for some times .

October 7, 2011

hope you don't mind

(defun c:test ( / ss->lst addpolyline *error* ss pt gr )
 (defun ss->lst ( ss flag / id lst )
   (if (eq 'PICKSET (type ss))
     (repeat (setq id (sslength ss))
       (
         (lambda ( name )
           (setq lst
             (cons
               (if flag (vlax-ename->vla-object name)
                 name
               )lst
             )
           )
         )(ssname ss (setq id (1- id)))
       )
     )
   )
 )
 (defun addpolyline ( pointslst layer closed flag / e )
   (setq e 
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (cons 90 (length pointslst))
           (cons 70 (if closed 1 0))
           (cons 8 layer)
           (cons 43 0.0)
         )
         (mapcar
           (function
             (lambda ( x ) 
               (if (listp x)(cons 10 x)
                 (cons 42 x)
               )
             )
           ) pointslst
         )
       )
     )
   )
   (if (and e flag)
     (vlax-ename->vla-object e) e
   )
 )
 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (if 
   (and
     (setq ss (ss->lst (ssget '((0 . "point"))) t))
     (setq pt (getpoint "\nSpecify starting point: "))
     (not 
       (vla-highlight 
         (car 
           (ss->lst (ssget pt '((0 . "point"))) t)
         ) 1
       )
     )
     (setq pt (list pt))
   )
   (progn
     (while (eq 5 (car (setq gr (grread t 5))))
       (foreach x (ss->lst (ssget (cadr gr) '((0 . "point"))) t)
         (if 
           (and (vl-position x ss)
             (not 
               (vl-position (vlax-get x 'coordinates)
                 pt
               )
             )
           )
           (progn (vla-highlight x 1)
             (setq pt (cons (vlax-get x 'coordinates) pt))
           )
         )
       )
     )
     (addpolyline (reverse pt) (getvar 'clayer) nil nil )
   )
 ) (vla-regen (ad) acactiveviewport)(princ)
)

Edited October 7, 2011 by Lt Dan's legs
fixed error's

October 7, 2011

I was indicating to Dan's post which would crash the routine if the user selected nothing ( nil ) .

My first suggestion is for testing only. I guess I should've noted that

October 7, 2011

 
;Created by B. Hippe
;October 2011
;Select points you wish to snap to.
;Click button to start.
;Hover mouse over the selected points in the order you wish to have them drawn.
[color="red"](vl-load-com)[/color]
(defun c:AutoPL ( / *ModSpc *ActDoc *acad ss sslen junk done pnt ep )
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (princ "\nSelect Point Objects:")
 (setq ss (ssget '(( 0 . "POINT"))))
 (if (or (= ss nil)(= (sslength ss) 1))
   (progn
     (princ "\nOops! Little to Nothing has been Selected.")
     (exit)
     )
   )

 (setq sslen (sslength ss))
 (setq drawn nil)
 (setq junk (getpoint "\nClick to Start:"))
 (setq done nil)
 (while
   (and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
   (setq ep (is_nearest ss (nth 1 pnt)))
   (cond
     ((= drawn nil)(progn
       (setq drawn (list (car ep)))
       (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
     ((= (length drawn) 1)(if (not (is_drawn (car ep)))
       (progn
         (setq drawn (cons (car ep) drawn))
         (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     ((>= (length drawn) 2)(if (not (is_drawn (car ep)))
        (progn
   (setq drawn (cons (car ep) drawn))
   (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
     )
   (if (= sslen (length drawn))
     (setq done T))
   )
 (setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist))))
 (princ)
 )

;Returns a list (entity . distance) of the closest entity (point) to the givin point
;Closest being the 2D distance
(defun is_nearest (ss opnt / ss-len li n ent pnt dist pair near-pair)
 (setq ss-len (sslength ss))
 (setq li '(0))
 (setq n 0)
 (repeat ss-len
   (setq ent (ssname ss n))
   (setq pnt (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) 'Coordinates))))
   (setq dist (distance (list (nth 0 opnt)(nth 1 opnt))(list (nth 0 pnt)(nth 1 pnt))))
   (setq pair (cons ent dist))
   (setq li (cons pair li))
   (setq n (1+ n))
   )
 (setq li (cdr (reverse li)))
 (setq li (vl-sort li (function (lambda (x y) (< (cdr x)(cdr y))))))
 (setq near-pair (nth 0 li))
 )
;graphically draws an X at a givin point
(defun drx (ctr / vs xs xs2 cor1 cor2 cor3 cor4 ctr)
 (setq vs (getvar "viewsize"))
 (setq xs (/ vs 20))
 (setq xs2 (/ xs 2))
 (setq cor1 (polar ctr (* pi 0.25) xs2))
 (setq cor2 (polar ctr (* pi 0.75) xs2))
 (setq cor3 (polar ctr (* pi 1.25) xs2))
 (setq cor4 (polar ctr (* pi 1.75) xs2))
 (grdraw ctr cor1 2 0)
 (grdraw ctr cor2 2 0)
 (grdraw ctr cor3 2 0)
 (grdraw ctr cor4 2 0)
 )

;Determines if a givin entity is a member of the "drawn" list
(defun is_drawn (ent)
 (/= nil (member ent drawn)))

;create a list of coordinates for each entity in the list "drawn"
(defun drawn->pntlist ( / plist ent li n )
 (setq plist (mapcar '(lambda (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object ent) 'Coordinates)))) drawn))
 (setq li '("x"))
 (setq n 0)
 (repeat (length plist)
   (setq p (nth n plist))
   (setq li (cons (nth 2 p) li))
   (setq li (cons (nth 1 p) li))
   (setq li (cons (nth 0 p) li))
   (setq n (1+ n))
   )
 (setq li (reverse (cdr (reverse li))))
 )

;Givin a point list returns the list in variant form
(defun PL->VAR ( pl / ub sa var)
 (setq ub (- (length [color=red]pl[/color]) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )

Localized variables, added error trap for nil selection set.

One question I had is that I have different sub-routines that will utilize the list "drawn". How should I approach this? It can't be localized or can it? If I made it local will the other routines be able to use it?

Thanks!

Edited January 6, 2014 by Hippe013
Edit Code (See Red)

October 7, 2011

 
added error trap for nil selection set.[/quote]

try instead

[code](if 
 (and
   (setq ss (ssget '((0 . "point"))))
   (setq junk (getpoint "\nClick to Start:"))
 )
 (progn ... etc.

October 10, 2011

Maybe some form of within polygon but polygon is created by drawing an initial line with a polygon width factor.

October 10, 2011

try instead

(if 
(and
(setq ss (ssget '((0 . "point"))))
(setq junk (getpoint "\nClick to Start:"))
)
(progn ... etc.

(defun c:AutoPL ( / *ModSpc *ActDoc *acad ss sslen junk done pnt ep )
 (setq *ModSpc (vlax-get-property (setq *ActDoc (vlax-get-property (setq *acad (vlax-get-acad-object)) 'ActiveDocument)) 'ModelSpace))
 (princ "\nSelect Point Objects:")
 [color=red](if[/color]
[color=red]   (and[/color]
[color=red]     (setq ss (ssget '(( 0 . "POINT"))))[/color]
[color=red]     (setq junk (getpoint "\nClick to Start")))[/color]
[color=red]   (progn[/color]
     (setq sslen (sslength ss))
     (setq drawn nil)
     (setq done nil)
     (while
(and (= 5 (car (setq pnt (grread T 1 0)))) (= done nil))
(setq ep (is_nearest ss (nth 1 pnt)))
(cond
  ((= drawn nil)(progn
    (setq drawn (list (car ep)))
    (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates))))))
  ((= (length drawn) 1)(if (not (is_drawn (car ep)))
    (progn
      (setq drawn (cons (car ep) drawn))
      (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
  ((>= (length drawn) 2)(if (not (is_drawn (car ep)))
     (progn
       (setq drawn (cons (car ep) drawn))
       (drx (vlax-safearray->list (vlax-variant-value (vlax-get-Property (vlax-ename->vla-object (car ep)) 'Coordinates)))))))
  )
(if (= sslen (length drawn))
  (setq done T)))
     (setq pl-obj (vlax-invoke-method *ModSpc 'Addpolyline (pl->var (drawn->pntlist)))))
   (exit))
 (princ)
 )

Lt Dan's legs, Good suggestion!

@ Bigal - I guess that I am not sure what you mean. Are you thinking about adding width options for the polyline - Add closing options? Could you clearify?

October 10, 2011

if you use

(vlax-get (vlax-ename->vla-object ep) 'coordinates)

it will return the coordinates..

October 10, 2011

if you use
(vlax-get (vlax-ename->vla-object ep) 'coordinates)

it will return the coordinates..

I had thought about that. I wouldn't have to use (vlax-safe-array->list (vlax-variant-value... Though what if I wanted this to use Civil 3D Points as well? Does (vlax-get (vlax-ename->vla-object ent) 'location) work as well? If so I could subsitute the 'coordinates with a variable to have it change from coordinates to location. I have been having a little trouble testing this as sometimes I get a value and other times I get the error: Civil 3D API: The handle is invalid.

October 10, 2011

I'm not sure I know what you mean but...

you could do something like

(vlax-get ep
 (if (vlax-property-available-p ep "location")
   "location" "coordinates"
 )
)

October 10, 2011

I'm not sure I know what you mean but...
you could do something like
(vlax-get ep
(if (vlax-property-available-p ep "location")
"location" "coordinates"
)
)

Thinking something like this:

 
(setq property 'Location)
(vlax-get-property property)

or

 
(setq property 'Coordinates)
(vlax-get-property property)

I guess at this point I am not how I should implement various objects such as Point, Civil 3D Point or Land Desktop Point.

October 11, 2011

Did you try my suggestion?

you could use dxf code 10... seems to be a simple solution

(cdr (assoc 10 (entget ep))))

October 11, 2011

Did you try my suggestion?

you could use dxf code 10... seems to be a simple solution

(cdr (assoc 10 (entget ep))))

I haven't tried your suggestion as of yet. Though the use of (assoc 10... will not work with Civil 3D Points. The only way I know of accessing the Civil 3D Point is through the VLA Object.

January 6, 2014

Command: AUTOPL

; error: no function definition: VLAX-GET-ACAD-OBJECT

January 6, 2014

Command: AUTOPL
; error: no function definition: VLAX-GET-ACAD-OBJECT

Just add the (vl-load-com) at the top of the routine and try again

Sign In

Auto Draw Polyline

Recommended Posts

Hippe013

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lt Dan's legs

Tharwat

Hippe013

Hippe013

Tharwat

Lt Dan's legs

Lt Dan's legs

Hippe013

Lt Dan's legs

BIGAL

Hippe013

Lt Dan's legs

Hippe013

Lt Dan's legs

Hippe013

Lt Dan's legs

Hippe013

rk25134

Tharwat

Join the conversation

Tutorials

Forums

Activity