;;; Draw Arcs between electrical devices for Electrical Plans
;;; Created by Beekee CZ http://forums.autodesk.com/t5/user/viewprofilepage/user-id/1779365
;;; Based on Kent Cooper's routine WA
;;; http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/connecting-blocks-with-line-or-arc-for-electrical-plans/m-p/5511255#M330024

(vl-load-com)

(defun C:WA (/ *error* _SortPtListByDist MidObjectsBoundingBox oCMDECHO oOSMODE doc pt pt1 pt2 ptm ptl ss i high)
(alert "\nSelect INSERTs or CIRCLEs and single POLYLINE conecting it")
;-------
(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)
(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)

(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
"_.TRIM" "" pt1 pt2 "")
(setq i (1+ i)))
(princ "\nWrogn selection. Need INSERTs or CIRCLEs and single POLYLINE conecting it"))

(setvar 'CMDECHO oCMDECHO)
(setvar 'OSMODE oOSMODE)
(vla-endundomark doc)
(princ)

)
(c:wa)

Advertisements