I need create polylines between nearest blocks that link their base points.
example ( image B ) :
1.- the first polyline ( color YELLOW ) should be the longest polyline
2.- the second polyline ( color magenta ) create a link between nearest leftovers blocks and link with YELLOW
3.- the third polyline ( color green ) connect with leftovers of leftovers nearest blocks and link with MAGENTA
I found a LISP that works great but does not do what I need.
(defun c:connect ( / ss i e plist p nextpt plist-sorted rtn pp )
(while (or (prompt "\nSelect blocks or circles...") (not (setq ss (ssget '((0 . "INSERT,CIRCLE"))))))
(prompt "\nEmpty sel. set...")
)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq plist (cons (cdr (assoc 10 (entget e))) plist))
)
(setq p (getpoint "\nPick or specify start point - use osnap cen or ins : "))
(defun nextpt ( p plist / car-sort pp )
(defun car-sort ( l f / removenth r k )
(defun removenth ( l n / k )
(setq k -1)
(vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
)
(setq k -1)
(vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
r
)
(setq plist (vl-remove-if '(lambda ( x ) (equal x p 1e-3)) plist))
(setq pp (car-sort plist '(lambda ( a b ) (<= (distance p a) (distance p b)))))
(list pp plist)
)
(if p
(progn
(while (cadr plist)
(setq plist-sorted (cons p plist-sorted))
(setq rtn (nextpt p plist))
(setq pp (car rtn) plist (cadr rtn))
(setq p pp)
)
(setq plist-sorted (cons (car plist) plist-sorted))
(setq plist-sorted (reverse plist-sorted))
(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length plist-sorted))
(cons 70 (if (= 1 (getvar 'plinegen)) 128 0))
'(38 . 0.0)
)
(mapcar '(lambda ( p ) (cons 10 p)) plist-sorted)
(list '(210 0.0 0.0 1.0))
)
)
)
)
(princ)
)here a example of what do this LISP:
