Lisp that adds circle to each endpoint

Lisp that adds circle to each endpoint

cyberflow
Advisor Advisor
6,071 Views
12 Replies
Message 1 of 13

Lisp that adds circle to each endpoint

cyberflow
Advisor
Advisor

Hi there,


I am looking for a lisp that adds circles to all endpoints of a polyline.

 

The purpose of this is so that i can identify changes on a street geometry and add cotation so the constructor can build it.

 

I've put 2 prints screen, one is to show the basic idea the other is an example of what i do manually.


Dunno if there's already something out there ?
Before thinking of coding it.

Frank Freitas

CAE/CAD/BIM Coordinator & Support Specialist

LinkedIn
Accepted solutions (2)
6,072 Views
12 Replies
Replies (12)
Message 2 of 13

Kent1Cooper
Consultant
Consultant
Accepted solution

I didn't find anything in a quickie Search, but in very  simplest terms:

(vl-load-com)
(defun C:CPV (/ pl n); = Circles at Polyline Vertices
  (setq pl (car (entsel "\nSelect Polyline to mark vertices with Circles: ")))
  (repeat (setq n (1+ (cdr (assoc 90 (entget pl)))))
    (command "_.circle" (vlax-curve-getPointAtParam pl (setq n (1- n))) YourCircleRadius)
  )
)

 

It could be made to verify that you picked something, and the right kind of thing, to work on multiple Polylines at once instead of just one, to base the radius on the screen size or some other criterion, to ask the User for a radius and remember it to offer as a default on subsequent use, to control for Object Snap [turn that off to try it if ENDpoint is not among your running modes], and lots of other enhancements, but see what you think of it as a start.

Kent Cooper, AIA
Message 3 of 13

cyberflow
Advisor
Advisor

Hello,

I've tryed it and after selecting the polyline here's what happens :

 

Commande:  CPV
Select Polyline to mark vertices with Circles: nil

 

Frank Freitas

CAE/CAD/BIM Coordinator & Support Specialist

LinkedIn
0 Likes
Message 4 of 13

Kent1Cooper
Consultant
Consultant
Accepted solution

Did you put a value in place of YourCircleRadius ?  The bold/red/italic was in the expectation that you would see it and realize it needs an actual value, but maybe I should have pointed it out more explicitly.

 

If you did, did it not draw the Circles?  The (command) function always returns nil, which can be suppressed if you like, but it doesn't mean it didn't do its thing.

Kent Cooper, AIA
0 Likes
Message 5 of 13

cyberflow
Advisor
Advisor

Oh god, forgot to read properly the code before.


Thank you !

 

Is there a way to put a decimal number instead of an integer ?

Frank Freitas

CAE/CAD/BIM Coordinator & Support Specialist

LinkedIn
0 Likes
Message 6 of 13

cyberflow
Advisor
Advisor

@cyberflowwrote:

Oh god, forgot to read properly the code before.


Thank you !

 

Is there a way to put a decimal number instead of an integer ?



Thank you !

Found how to :

 

(float 0.1)

Frank Freitas

CAE/CAD/BIM Coordinator & Support Specialist

LinkedIn
0 Likes
Message 7 of 13

Kent1Cooper
Consultant
Consultant

@cyberflow wrote:

....

Is there a way to put a decimal number instead of an integer ?


....

Found how to :

 

(float 0.1)

Not necessary -- you can just put 0.1 in directly.

 

EDIT:  BUT  I made a mistake -- the one line should be:

 

  (repeat (setq n (cdr (assoc 90 (entget pl))))

 

without the (1+) function.  I was thinking of a different quality of certain counting functions, and probably also not thinking clearly about whether the difference between a closed and open Polyline would matter.  I'm not sure why it initially worked with an integer but not a decimal value, but it's probably not worth figuring that out.

Kent Cooper, AIA
0 Likes
Message 8 of 13

Anonymous
Not applicable

Here's something I first wrote in 1990 (!).  This program is old enough to drink!

 

;PLINEDOT Pick a polyline and this command will draw circles
; at every unique vertex. Originally written in 1990; shortened
; and revised for R14 LWPOLYLINES in 1999. Revised again in 2005 to
; work on a selection set of ARCS, LINES, LWPOLYLINES and POLYLINES.
; In this revision it only draws unique points, ignoring new points
; within 1/100 the radius of the plotted circles from another point
; in the list.
; Terrible Software 1990-2005 WDK

(defun-q C:PLINEDOT( / olducf oldcmd olderr worldu ans
                       edata 10list eset iplist add2ip point
                   )
 (setq olducf (getvar "ucsfollow") oldcmd (getvar "cmdecho") olderr *error*)
 (setvar "ucsfollow" 0)
 (setvar "cmdecho" 0)
 (setq worldu nil)
 (if (= 0 (getvar "worlducs"))
  (command "ucs" "world")
  (setq worldu T)
 )
 (if (null debugg)
  (defun-q *error*(msg)
   (if msg
    (if (null (member msg (list "Function cancelled")))
     (princ (strcat "\nERROR: " msg ". "))
    )
   )
   (if (null worldu)
    (command "ucs" "p")
   )
   (setvar "cmdecho" oldcmd)
   (setvar "ucsfollow" olducf)
   (setq *error* olderr)
   (prin1)
  )
 )
 (defun-q add2ip(point / OK epoint )
  (setq OK T)
  (foreach epoint iplist
   (if (> (* 0.01 plinedot_radius)(distance epoint point))
    (setq OK nil)
   )
  )
  (if OK
   (setq iplist (cons point iplist))
  )
 )  
 (if (numberp plinedot_radius)
  (if (<= plinedot_radius 0.0)
   (setq plinedot_radius nil)
  )
  (setq plinedot_radius nil)
 )
 (if plinedot_radius
  (progn
   (initget 6)
   (if
    (setq ans
     (getreal
      (strcat "\nEnter circle radius <" (rtos plinedot_radius 2 4) ">: ")
     )
    )
    (setq plinedot_radius ans)
   )
  )
  (progn
   (initget 7)
   (setq plinedot_radius (getreal "\nEnter circle radius: "))
  )
 )
 (setq iplist nil) ; list of insertion points of circles
 (princ "\nSelect LINES, ARCS, POLYLINES and LWPOLYLINES: ")
 (if
  (setq eset
   (ssget
    (list
     (cons -4 "<or")
      (cons 0 "LINE")
      (cons 0 "POLYLINE")
      (cons 0 "LWPOLYLINE")
      (cons 0 "ARC")
     (cons -4 "or>")
    )
   )
  )
  (progn
   (princ (strcat "\n" (itoa (sslength eset)) " entities selected..."))
   ; compile IPLIST, list of unique points
   (foreach edata (ss2edl eset)
    (cond
     ((= (cdr (assoc 0 edata)) "POLYLINE")
      (setq loop T vname (cdr (assoc -1 edata)))
      (while loop
       (if (setq vname (entnext vname))
        (if (= "SEQEND" (cdr (assoc 0 (setq vdata (entget vname)))))
         (setq loop nil)
         (add2ip (cdr (assoc 10 vdata)))
        )
        (setq loop nil)
       )
      )
     )
     ((= (cdr (assoc 0 edata)) "LWPOLYLINE")
      (while (setq 10list (assoc 10 edata))
       (add2ip (cdr 10list))
       (setq edata (cdr (member 10list edata)))
      )
     )
     ((= (cdr (assoc 0 edata)) "LINE")
      (add2ip (cdr (assoc 10 edata)))
      (add2ip (cdr (assoc 11 edata)))
     )
     ((= (cdr (assoc 0 edata)) "ARC")
      (add2ip (polar (cdr (assoc 10 edata))(cdr (assoc 50 edata))(cdr (assoc 40 edata))))
      (add2ip (polar (cdr (assoc 10 edata))(cdr (assoc 51 edata))(cdr (assoc 40 edata))))
     )
     (T (princ "I thought we filtered out everything but LINES, ARCS, POLYLINES and LWPOLYLINES!  What gives? "))
    )
   ) ; end foreach
   ; now draw circles at each point in IPLIST
   (foreach point iplist
    (command "circle" point plinedot_radius)
   )
   (if dos_beep
    (dos_beep 550 125)
   )
   (princ (strcat "Done! " (itoa (length iplist)) " circles drawn. "))
   (setq eset nil)
  ) ; end progn
  (princ "\nNo ARCS, LINES or POLYLINES selected. ")
 )
 (*error* nil)
 (princ "\nOperation finished. Thank you very much. Terrible Software inc.\n")
 (prin1)
)

Message 9 of 13

Anonymous
Not applicable

What if i need it for multiple lines


@Kent1Cooper wrote:

I didn't find anything in a quickie Search, but in very  simplest terms:

(vl-load-com)
(defun C:CPV (/ pl n); = Circles at Polyline Vertices
  (setq pl (car (entsel "\nSelect Polyline to mark vertices with Circles: ")))
  (repeat (setq n (1+ (cdr (assoc 90 (entget pl)))))
    (command "_.circle" (vlax-curve-getPointAtParam pl (setq n (1- n))) YourCircleRadius)
  )
)

 

It could be made to verify that you picked something, and the right kind of thing, to work on multiple Polylines at once instead of just one, to base the radius on the screen size or some other criterion, to ask the User for a radius and remember it to offer as a default on subsequent use, to control for Object Snap [turn that off to try it if ENDpoint is not among your running modes], and lots of other enhancements, but see what you think of it as a start.


0 Likes
Message 10 of 13

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

What if i need it for multiple lines ....


That would be something like this [minimally tested] :

(vl-load-com)
(defun C:CPV (/ ss i pl n); = Circles at Polyline Vertices
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss)); then (setq pl (ssname ss (setq i (1- i)))) (repeat (setq n (cdr (assoc 90 (entget pl)))) (command "_.circle" (vlax-curve-getPointAtParam pl (setq n (1- n))) YourCircleRadius) ); repeat [vertices]
); repeat [Polylines]
); if ); defun

 

Kent Cooper, AIA
Message 11 of 13

Lukasvop1
Advocate
Advocate

Hello,
I found your lisp and it's exactly what I searching for but I need bit customize it..
I need create "Points" on lines "Vertex". (Not "Circles" on "Polyline") like on pic.
If you have a moment I will appreciated it.

 

Lisp_Points_on_line_vertex.png

 

0 Likes
Message 12 of 13

Kent1Cooper
Consultant
Consultant

@Lukasvop1 wrote:

.... I need create "Points" on lines "Vertex". (Not "Circles" on "Polyline") ....


If by that you mean at both ends of all selected Line objects [they don't have "vertices," after all], try this adjustment [minimally tested]:

(vl-load-com)
(defun C:PLE (/ ss i pl n); = Points at Line Endpoints
(if (setq ss (ssget '((0 . "LINE"))))
(repeat (setq i (sslength ss)); then (setq lin (ssname ss (setq i (1- i)))) (command
"_.point" "_non" (vlax-curve-getStartPoint lin) "_.point" "_non" (vlax-curve-getEndPoint lin)
); command
); repeat [Lines]
); if ); defun

Consider whether to have it set a PDMODE value [and maybe PDSIZE] for your preferred "look" if you might not already have that set.

 

Doesn't account for different UCS, nor have the usual enhancements that could be added.  It could be made to put the Points on the same Layer as each Line, or to set a particular Layer for them, etc.

Kent Cooper, AIA
Message 13 of 13

Lukasvop1
Advocate
Advocate

Thank you, works perfect.