QUICK REQUEST!!

[Anonymous]

Hi,

thanks for helping, I just need this lisp attached to create lines instead of arcs between the objects selected.

Thank you.

(vl-load-com)

(defun C:CB (/ *error* _SortPtListByDist MidObjectsBoundingBox oCMDECHO oOSMODE doc pt pt1 pt2 ptm ptl ss i high sset nextent startentity current_layer)

;-------
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg)))
(setvar 'CMDECHO oCMDECHO)
(setvar 'OSMODE oOSMODE)
(vla-endundomark doc)
(princ))

;-------
(defun _SortPtListByDist (ptList)
;; Argument: Point list
;; Returns: Point list, sorted by distance from curve
;; By BlackBox
;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
(mapcar
'(lambda (x / ptList2)
(setq ptList2 (append (cdr x) ptList2)))
(vl-sort
(mapcar
'(lambda (x / pt ptlist2)
(setq ptlist2
(append
(cons
(vlax-curve-getDistAtPoint
(ssname sspl 0)
(vlax-curve-getClosestPointTo (ssname sspl 0) x T))
x)
ptlist2)))
ptList)
'(lambda (x y)
(< (car x) (car y))))))

;-------
(defun MidObjectsBoundingBox (en / Bmin Bmax )
;; Argument: Entity
;; Returns: Point list of centre

(vla-GetBoundingBox (vlax-ename->vla-object en) 'PtArMin 'PtArMax)
(setq Bmin (vlax-safearray->list PtArMin)
Bmax (vlax-safearray->list PtArMax))
(polar Bmin
(angle Bmin Bmax)
(/ (distance Bmin Bmax) 2))
)

;---------------------------------------------------------------------------------
;---------------------------------------------------------------------------------

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)

(setq oCMDECHO (getvar 'CMDECHO))
(setq oOSMODE (getvar 'OSMODE))
(setvar 'OSMODE 0)

(setq current_layer (getvar "CLAYER"))
(setq startentity (entlast))

(if (and (setq ss (ssget '((0 . "INSERT,CIRCLE,*LINE"))))
(<= 3 (sslength ss))
(= 1 (sslength (setq sspl (ssget "_p" '((0 . "*LINE"))))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(if (wcmatch (cdr (assoc 0 (entget (ssname ss i)))) "CIRCLE,INSERT")
(setq pt (MidObjectsBoundingBox (ssname ss i))
ptl (if ptl
(append (list pt) ptl)
(list pt)))
T))
ptl
(setq ptl (_SortPtListByDist ptl)
i 0))
(repeat (1- (length ptl))
(setq pt1 (nth i ptl)
pt2 (nth (1+ i) ptl)
ptm (polar (polar pt1
(angle pt1 pt2)
(/ (distance pt1 pt2) 2))
(+ (angle pt1 pt2) (* pi 0.5)) ;for OPPOSITE BULGE set 1.5 instead of 0.5
(cond (high)
(T (setq high (* (distance pt1 pt2) 0.18)))))) ;change 0.18 for MORE BULGE
(command "_.arc" pt1 ptm pt2)
(setq i (1+ i)))
(princ "\nWrogn selection. Need INSERT, CIRCLE and single *LINE"))

(setq sset (ssadd))
(setq nextent (entnext startentity))
(while (/= nil nextent)
(setq sset (ssadd nextent sset))
(setq nextent (entnext nextent))
)

(initcommandversion)
(command "join" sset "")
(setvar 'CMDECHO oCMDECHO)
(setvar 'OSMODE oOSMODE)
(setvar "CLAYER" current_layer)
(vla-endundomark doc)
(princ)

)

[Anonymous]

What I really need is just a lisp that will connect multiple blocks together by a pline from insertion point to insertion point connection each block consecutively to the closest one of the selection.

[Moshe-A · Accepted solution]

@Anonymous  hi,

check this one called BCHAIN. the order goes from left to right and up to down.

note: laying blocks in matrix form will connect the most right block in the row with the first in the row below. 

enjoy

moshe

; block chain

(defun c:bchain (/ ss lst)
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq ss (ssget '((0 . "insert"))))
  (progn
   (setq lst
	  (mapcar
            '(lambda (ename)
               (cdr (assoc '10 (entget ename))) 
             )
            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          )
   ); setq

   (if lst
    (progn
     (setq lst
	    (vl-sort
       		(vl-sort lst '(lambda (a0 a1) (< (cadr a0) (cadr a1)))) ; sort in X axis
	        '(lambda (a0 a1) (< (car a0) (car a1)))			; sort in Y axis
	    )	
     ); setq

     (command "._pline")
     (foreach pt lst
      (command "_none" pt)
     )
     (command "")
    ); progn
   ); if
   
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)

 (princ)
); c:bchain

[Anonymous]

Thanks Moshe! That is exactly what I needed, works like a charm!