Message 1 of 12

Not applicable
03-04-2018
05:27 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
I have been trying to modify some code (WA+ from Beekee CZ) from this thread to change functionality a bit, but my basic LISP skills are letting me down.
Basically i want to be able to select some blocks and have a joined polyline with arcs connecting the insertion points via closest distance between blocks.
This code will insert the arcs as separate items, which is ok, but i cant get it to join afterwards.
And i would really like to not have the initial selection polyline required.
If anyone could assist that would be greatly appreciated. Thanks!
;; Based on Beekee CZ's alteration of 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:joinlines (/ *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)) ) (command "join" sset) (setvar 'CMDECHO oCMDECHO) (setvar 'OSMODE oOSMODE) (setvar "CLAYER" current_layer) (vla-endundomark doc) (princ) )
Solved! Go to Solution.