Jump to content

POLYLINE between CENTER of CIRCLES

ojacomarket

By ojacomarket
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ojacomarket Contributor

ojacomarket

Posted
Posted

Dear friends,

I'm new here. But I'm tryin to combine AUTOLISP functions as ssget, assoc, enget etc to get a signle function , that will allow to select on one of the circles, press enter, and it will draw a polyline between circles that are located in the same LAYER.

Do you have any ideas?
With best regards,
Arti

Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted

It's hard to imagine a picture on the head without an image or dwg sample. Could you perhaps post one?

Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
1 hour ago, Jonathan Handojo said:

It's hard to imagine a picture on the head without an image or dwg sample. Could you perhaps post one?

I have 4 + 4 circles, they have layer 0 matched

But they have different text written nearby.

So I want to CAD recognoze the text and draw one PLINE between H, and another between H1

 

Thank you for your response :)

examp.png

Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted (edited)

Could you perhaps post an image of the final result you're after?

 

Plus, it would be a lot easier if those were blocks whose attributes are H and H1 and the insertion points of the blocks are at the center of the circle.

Edited by Jonathan Handojo
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

It looks like circles with H1 or H next to them so that's ok and finding the circles is ok.

 

Now the problems are they always laid out like the image so the line joins left to right ? The biggest problem with auto can be the randomness of the circle positions.

 

Can you post a real dwg for testing.

 

 

Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted (edited)
On 4/6/2020 at 3:51 AM, BIGAL said:

It looks like circles with H1 or H next to them so that's ok and finding the circles is ok.

 

Now the problems are they always laid out like the image so the line joins left to right ? The biggest problem with auto can be the randomness of the circle positions.

 

Can you post a real dwg for testing.

 

 

Thank you for reply,

The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly.

In addition, it is no problem which direction CAD will construct lines, since the point is to recognize TEXT nearby and use this constant, which I mentioned above to  put line into center of circle, I rather would say the circles don't need in that case, the main object is TEXT.

With best regards,

test.dwg

Edited by ojacomarket
Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
3 hours ago, ojacomarket said:

Thank you for reply,

The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly.

In addition, it is no problem which direction CAD will construct lines, since the point is to recognize TEXT nearby and use this constant, which I mentioned above to  put line into center of circle, I rather would say the circles don't need in that case, the main object is TEXT.

With best regards,

test.dwg 626.67 kB · 2 downloads

I actually have the example of code, since I'm not so good at LISP, so I study yet, I don't know such complicated LISPs, I used simple ones and I got result, but not what I expected, for some reason the "PLINE" command applies only to my last two circles ENDPOINT and STARTPOINT, but as seen from code it supposed to connect all 10 circles with single PLINE.

 

I also pinned the result of that code..as .png

Code:

 

(defun c:PLtrace ()

    (setq list1 '()) ;create just list
    
        (setq circleset1 (ssget "x" '((0 . "CIRCLE") (8 . "mootmpunkt")))) ;select all circles (they should be 10)
    
            (setq circleset1length1 (sslength circleset1)) ; (checkin' how many circles in there
    
                (setq circlenum1 (- 1 )) ;variable for loop
        
                    (repeat circleset1length1 ;loop on selection set
                    
                        (setq circlenum1 (1+ circlenum1)) ;new value of variable
        
                            (setq circlenames (entget (ssname circleset1 circlenum1))) ;get names of variable of set
            
                                (setq circlecoords1 (cdr (assoc 10 circlenames))) ;taking coordinates of centers of the circles
                                
                                    (setq list1 (append list1 (list circlecoords1))) ; making list with those coordinates
                                    
                                        ) ;end repeat1
                                            
                                            (setq pl_com1 (- 1)) ;new variable for new loop
                                            
                                                    (setq pl_length1 (length list1)) ;length of list of coordinates list1
                                    
                                                        (repeat pl_length1 ;new loop 
                                                        
                                                            (setq pl_com1 (+ 1 pl_com1)) ;new value for variable inside loop, start point of PLINE
                                                            
                                                                (setq pl_com3 (+ 1 pl_com1)) ;new value for variable ENDPOINT of PLINE
                                                        
                                                                    (setq nomer_1 (nth pl_com1 list1)) ;taking out first element of list1, which is start point of pline
                                                                        
                                                                        (setq nomer_2 (nth pl_com3 list1));taking out first element of list1, which is end point of pline
                                                                        
                                                                            (command "PLINE" nomer_1 nomer_2) ; command pline which should take nomer1 nomer2 values to make pline
                                                                        
                                                                                ) ; end repeat2
                                                                                
                                                                                    (princ)
                                                                        
                                                                                        ) ;end defun

pltrace.png

Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted (edited)

Something like this?

  

(defun c:textcircle ( / circles dets ent i pl ss texts txt unique)
  (defun unique (lst / rtn)
    (while lst
      (setq rtn (cons (car lst) rtn)
	    lst (vl-remove (car lst) lst)
	    )
      )
    (reverse rtn)
    )
  (if (setq ss (ssget '((0 . "CIRCLE,TEXT,MTEXT"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "CIRCLE")
	  (setq circles (cons ent circles))
	  (setq texts (cons ent texts))
	  )
	)
      (foreach x circles
	(if
	  (setq txt
		 (car (vl-member-if
			'(lambda (y)
			   (equal
			     (cdr (assoc 10 (entget x)))
			     (cdr (assoc 11 (entget y)))
			     1e-8
			     )
			   )
			texts
			)
		      )
		)
	  (setq dets (cons (cons (cdr (assoc 1 (entget txt))) x) dets))
	  )
	)
      
      (foreach x (unique (mapcar 'car dets))
	(entmake
	  (append
	    '(
	      (0 . "LWPOLYLINE")
	      (100 . "AcDbEntity")
	      (100 . "AcDbPolyline")
	      )
	    (list (cons 90 (length (setq pl (vl-remove-if-not '(lambda (y) (eq x (car y))) dets)))))
	    (apply 'append
		   (mapcar '(lambda (y)
			      (list
				(assoc 10 (entget (cdr y)))
				'(40 . 0)
				'(41 . 0)
				'(42 . 0)
				'(91 . 0)
				)
			      )
			   pl
			   )
		   )
	    )
	  )
	)
      )
    )
  (princ)
  )

 

Edited by Jonathan Handojo
  • Thanks 1
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn.

 

image.thumb.png.fe91f408159660282ccda8e44a7150fd.png

 

My attempt

  

; simple join circles next to text.
; by Alan H April  info@alanh.com.au

(defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X)
  (setq offd 0.1)  ; change to (setq offd (getreal "\nEnter offset")) if text is further away
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (setq ent (entget (car (entsel "\nPick text for layer and value"))))
  (setq lay (cdr (assoc 8 ent)))
  (setq str (cdr (assoc 1 ent)))
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str))))
  (setq lst '())
  (repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq ins (vlax-get Obj 'insertionPoint))
    (setq rad (* 1.5 (vlax-get Obj 'Height)))
    (command "polygon" 20 ins "I" rad)  ;Autocad
    (setq obj2 (entlast))
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2))))
    (command "erase" obj2 "")
    (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle"))))
    (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center))
    (setq lst (cons cen lst))
  )
  (command "_pline")
  (while (= (getvar "cmdactive") 1)
    (repeat (setq x (length lst))
      (command (nth (setq x (- x 1)) lst))
    )
    (command "")
  )
  (setvar 'osmode oldsnap)
  (princ)
)

 

Edited by BIGAL
  • Thanks 1
Link to comment
Share on other sites
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted
9 hours ago, ojacomarket said:

The thing is, that those "H" and "H1" are always on the same position relative to circles (let's assume it is 5 m to X and 5 m to Y). And finding circles with ssget is also OK. But for now I want just to CAD recognize the "TEXT" nearby circle and draw line between circles, which are marked with same text, so after I can figure out how to put them in the SAME layer and join those line into poly.

 

If all you want to do is moving them to the same layer, you don't need polylines. Simply get a unique list of texts and circles, and can simply use entmod.

 

25 minutes ago, BIGAL said:

The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn.

 

I agree there, unless of course the selection itself is in order...

Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
3 hours ago, BIGAL said:

The task is not that hard but again the randomness of how the dwg was put together will determine how the pline is drawn.

 

image.thumb.png.fe91f408159660282ccda8e44a7150fd.png

 

My attempt

  


; simple join circles next to text.
; by Alan H April  info@alanh.com.au

(defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X)
  (setq offd 0.1)  ; change to (setq offd (getreal "\nEnter offset")) if text is further away
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  (setq ent (entget (car (entsel "\nPick text for layer and value"))))
  (setq lay (cdr (assoc 8 ent)))
  (setq str (cdr (assoc 1 ent)))
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str))))
  (setq lst '())
  (repeat (setq x (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
    (setq ins (vlax-get Obj 'insertionPoint))
    (setq rad (* 1.5 (vlax-get Obj 'Height)))
    (command "polygon" 20 ins "I" rad)  ;Autocad
    (setq obj2 (entlast))
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2))))
    (command "erase" obj2 "")
    (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle"))))
    (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center))
    (setq lst (cons cen lst))
  )
  (command "_pline")
  (while (= (getvar "cmdactive") 1)
    (repeat (setq x (length lst))
      (command (nth (setq x (- x 1)) lst))
    )
    (command "")
  )
  (setvar 'osmode oldsnap)
  (princ)
)

 

Thank you very much!
As I said, I'm not so smart at LISP, beacause still learning, but I see there new for me function "vlax" and "lambda" I will go through them and then it is clear for me.
Again thank you for your time!

Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
2 hours ago, Jonathan Handojo said:

 

If all you want to do is moving them to the same layer, you don't need polylines. Simply get a unique list of texts and circles, and can simply use entmod.

 

 

I agree there, unless of course the selection itself is in order...

Thank you as much as for BIGAL, you helped indeed, but I need a bit learning of those new functions, then I could understand how programm works, it is much better for me. But your code is excellent!

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

have a look at this

  

(defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X)
  
  (setq oldsnap (getvar 'osmode)) ; save current osnaps
  (setvar 'osmode 0) ; turn off osnaps
  (setq ent (entget (car (entsel "\nPick text for layer and value")))) ; select a text obect
  (setq lay (cdr (assoc 8 ent))) ; get object layer dxf code 8
  (setq str (cdr (assoc 1 ent))) ; get object text dxf code 1
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) ; get objects that are text on layer plus text string
  (setq lst '()) ; set list to blank in case exists already
  (repeat (setq x (sslength ss)) ; do for every text in slection 
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; get each item in selection set
    (setq ins (vlax-get Obj 'insertionPoint)) ; get text insertion point
    (setq rad (* 1.5 (vlax-get Obj 'Height))) ; dummy value for a polygon to look for a nearby Circle
    (command "polygon" 20 ins "I" rad)  ;Autocad Note briscad is different
    (setq obj2 (entlast)) ; save the name of the last object created
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) ; loops through the pline vertice points
    (command "erase" obj2 "") ; no longer required as needed points
    (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) ; looks for circles that touch the polygon
    (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) ; gets the center point of the circle
    (setq lst (cons cen lst)) ; makes a list of all the pline points
  )
  (command "_pline") ; start pline command
  (while (= (getvar "cmdactive") 1) ; is pline running
    (repeat (setq x (length lst)) ; repeat for all the points
      (command (nth (setq x (- x 1)) lst)) ; pass the point co-ords to the pline command
    )
    (command "") ; end pline
  )
  (setvar 'osmode oldsnap) ; reset the osnaps
  (princ) ; quite exit of defun
)

 

  • Thanks 1
Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
1 hour ago, BIGAL said:

have a look at this

  


(defun c:toff (/ CEN CO-ORD ENT INS LAY LST OBJ OBJ2 OFFD OLDSNAP RAD SS SS2 STR X)
  
  (setq oldsnap (getvar 'osmode)) ; save current osnaps
  (setvar 'osmode 0) ; turn off osnaps
  (setq ent (entget (car (entsel "\nPick text for layer and value")))) ; select a text obect
  (setq lay (cdr (assoc 8 ent))) ; get object layer dxf code 8
  (setq str (cdr (assoc 1 ent))) ; get object text dxf code 1
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 lay) (cons 1 str)))) ; get objects that are text on layer plus text string
  (setq lst '()) ; set list to blank in case exists already
  (repeat (setq x (sslength ss)) ; do for every text in slection 
    (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; get each item in selection set
    (setq ins (vlax-get Obj 'insertionPoint)) ; get text insertion point
    (setq rad (* 1.5 (vlax-get Obj 'Height))) ; dummy value for a polygon to look for a nearby Circle
    (command "polygon" 20 ins "I" rad)  ;Autocad Note briscad is different
    (setq obj2 (entlast)) ; save the name of the last object created
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj2)))) ; loops through the pline vertice points
    (command "erase" obj2 "") ; no longer required as needed points
    (setq ss2 (ssget "F" co-ord (list (cons 0 "Circle")))) ; looks for circles that touch the polygon
    (setq cen (vlax-get (vlax-ename->vla-object (ssname ss2 0)) 'center)) ; gets the center point of the circle
    (setq lst (cons cen lst)) ; makes a list of all the pline points
  )
  (command "_pline") ; start pline command
  (while (= (getvar "cmdactive") 1) ; is pline running
    (repeat (setq x (length lst)) ; repeat for all the points
      (command (nth (setq x (- x 1)) lst)) ; pass the point co-ords to the pline command
    )
    (command "") ; end pline
  )
  (setvar 'osmode oldsnap) ; reset the osnaps
  (princ) ; quite exit of defun
)

 

Explanation is so clear, that I now have an idea how it really works, thank you for your help. I will proceede with those tasks and continue to study those commands. I can see that vlax is used quite often in LISP.

Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted

I think you'll find that the insertion point of the text is the same as the centre of the circle (Top Left) and each text is preceeded by a space. The line is a shortest route problem, so you perhaps find the convex hull of each set of points (H  & H1) as a starting pint, work from there then remove the longest segment.IIRC the last time this came up was about 1.5 - 2 years ago (no more) on the Autodesk forums

  • Thanks 1
Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted

Try this mishmash of routines. I've tried it in a dozen scenarios and point configurations and it seems to work, but I have a feeling I'm missing a case where it might fail.

  

(vl-load-com)

(defun rh:emLWP (lst cls)
  (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls))
                    (mapcar (function (lambda (x) (cons 10 x))) lst)
            );end_append
  );end_entmakex
);end_defun

(defun rh:mslen (ent / sp ep obj vlst lst msl)
  (setq sp 0 ep (vlax-curve-getendparam ent) vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
  (while (< sp ep) (setq lst (cons (list sp (- (vlax-curve-getdistatparam ent (1+ sp)) (vlax-curve-getdistatparam ent sp))) lst) sp (1+ sp)))
  (setq lst (reverse lst) msl (vl-position (car (vl-sort lst '(lambda (x y) (> (cadr x) (cadr y))))) lst))
  (while (not (minusp msl)) (setq vlst (append (cdr vlst) (list (car vlst))) msl (1- msl)))
  (entdel ent)
  (rh:emLWP vlst 0)
);end_defun

(defun _gp ( lst / sp cnt d n z )
  (cond (lst
          (setq d (distance (car lst) (cadr lst)) sp (car lst))
          (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (< d (setq n (distance x y))) (setq d n sp x))))
          (setq lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) lst))
          (rh:mslen (rh:emLWP lst 1))
        )
  );end_cond
);end_defun

(defun c:test ( / ss cnt ent elst ipt h_lst h1_lst)

  (setq ss (ssget '((0 . "TEXT")(8 . "Punkti_kood"))))
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  ipt (cdr (assoc (if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0)) 10 11) elst))
            );end_setq
            (if (= (cdr (assoc 1 elst)) " H") (setq h_lst (cons ipt h_lst)) (setq h1_lst (cons ipt h1_lst)))
          );end_repeat
        )
  );end_cond

  (foreach x (list h_lst h1_lst) (if x (_gp x)))
  (princ)
);end_defun

 

  • Thanks 1
Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
3 hours ago, dlanorh said:

Try this mishmash of routines. I've tried it in a dozen scenarios and point configurations and it seems to work, but I have a feeling I'm missing a case where it might fail.

  


(vl-load-com)

(defun rh:emLWP (lst cls)
  (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls))
                    (mapcar (function (lambda (x) (cons 10 x))) lst)
            );end_append
  );end_entmakex
);end_defun

(defun rh:mslen (ent / sp ep obj vlst lst msl)
  (setq sp 0 ep (vlax-curve-getendparam ent) vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
  (while (< sp ep) (setq lst (cons (list sp (- (vlax-curve-getdistatparam ent (1+ sp)) (vlax-curve-getdistatparam ent sp))) lst) sp (1+ sp)))
  (setq lst (reverse lst) msl (vl-position (car (vl-sort lst '(lambda (x y) (> (cadr x) (cadr y))))) lst))
  (while (not (minusp msl)) (setq vlst (append (cdr vlst) (list (car vlst))) msl (1- msl)))
  (entdel ent)
  (rh:emLWP vlst 0)
);end_defun

(defun _gp ( lst / sp cnt d n z )
  (cond (lst
          (setq d (distance (car lst) (cadr lst)) sp (car lst))
          (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (< d (setq n (distance x y))) (setq d n sp x))))
          (setq lst (mapcar '(lambda (x) (reverse (cdr (reverse x)))) lst))
          (rh:mslen (rh:emLWP lst 1))
        )
  );end_cond
);end_defun

(defun c:test ( / ss cnt ent elst ipt h_lst h1_lst)

  (setq ss (ssget '((0 . "TEXT")(8 . "Punkti_kood"))))
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  ipt (cdr (assoc (if (and (= (cdr (assoc 72 elst)) 0) (= (cdr (assoc 73 elst)) 0)) 10 11) elst))
            );end_setq
            (if (= (cdr (assoc 1 elst)) " H") (setq h_lst (cons ipt h_lst)) (setq h1_lst (cons ipt h1_lst)))
          );end_repeat
        )
  );end_cond

  (foreach x (list h_lst h1_lst) (if x (_gp x)))
  (princ)
);end_defun

 

Thank you very much, I'll try that code!

Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted

@ojacomarket Have you seen THIS  thread? Here's a quick modification to connect circles, blocks and points: 

(defun c:path (/ _daisychain p pt pts s x)
  ;; RJP » 04.09.2020
  (defun _daisychain (pt l / tmp out dsort)
    (defun dsort (pt l / d1 d2)
      (vl-sort l (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2)))))
    )
    (setq tmp (dsort pt l))
    (while (setq tmp (dsort (car tmp) tmp)) (setq out (cons (car tmp) out)) (setq tmp (cdr tmp)))
    (reverse out)
  )
  (cond	((and (setq p (getpoint "\nPick a point to sort from: "))
	      (setq s (ssget '((0 . "insert,circle,point"))))
	      (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	      (setq pts (_daisychain p (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) s)))
	 )
	 (entmakex (append (list '(0 . "LWPOLYLINE")
				 '(100 . "AcDbEntity")
				 '(100 . "AcDbPolyline")
				 (assoc 8 (entget (car s)))
				 (cons 90 (length s))
				 '(38 . 0.0)
			   )
			   (mapcar '(lambda (x) (cons 10 x)) pts)
			   (list '(210 0.0 0.0 1.0))
		   )
	 )
	)
  )
  (princ)
)
(vl-load-com)

 

  • Thanks 1
Link to comment
Share on other sites
ojacomarket Contributor

ojacomarket

Posted
  • Author
Posted
4 hours ago, ronjonp said:

@ojacomarket Have you seen THIS  thread? Here's a quick modification to connect circles, blocks and points: 


(defun c:path (/ _daisychain p pt pts s x)
  ;; RJP » 04.09.2020
  (defun _daisychain (pt l / tmp out dsort)
    (defun dsort (pt l / d1 d2)
      (vl-sort l (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2)))))
    )
    (setq tmp (dsort pt l))
    (while (setq tmp (dsort (car tmp) tmp)) (setq out (cons (car tmp) out)) (setq tmp (cdr tmp)))
    (reverse out)
  )
  (cond	((and (setq p (getpoint "\nPick a point to sort from: "))
	      (setq s (ssget '((0 . "insert,circle,point"))))
	      (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	      (setq pts (_daisychain p (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) s)))
	 )
	 (entmakex (append (list '(0 . "LWPOLYLINE")
				 '(100 . "AcDbEntity")
				 '(100 . "AcDbPolyline")
				 (assoc 8 (entget (car s)))
				 (cons 90 (length s))
				 '(38 . 0.0)
			   )
			   (mapcar '(lambda (x) (cons 10 x)) pts)
			   (list '(210 0.0 0.0 1.0))
		   )
	 )
	)
  )
  (princ)
)
(vl-load-com)

 

Thank you very much I can see from your code new elements for me, so I have to understand them first then use, but I probably try that one. Thank you for you time!

Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted
4 minutes ago, ojacomarket said:

Thank you very much I can see from your code new elements for me, so I have to understand them first then use, but I probably try that one. Thank you for you time!

You're welcome! 🍻

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...