I find AutoCAD's join command is a bit lacking to say the least and I have been writing some code to make it work better.
I am running into some issues with plines not working well, I have added comments where I believe the issues are, I am wondering if anyone can help me work this out?
(defun c:JA (/)
(c:joinall)
)
(defun c:JoinAll (/ SS Filter)
(princ "\rSelect objects to join: ")
(setq Filter '( (-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "<NOT") (-4 . "&") (70 . 89) (-4 . "NOT>")
(-4 . "AND>")
(-4 . "OR>")
)
)
(setq SS (ssget Filter))
(if SS
(JoinAll SS)
)
)
;Functions
(defun JoinAll (SS / *thisdrawing* *modelspace* *paperspace* *activespace* SSLen SS2Len Count1 Count2 Ent1 Ent2 SS2 Pts Ent1_Type Old_PeditAccept)
;Supporting Functions
(defun collinear (Ent1 Ent2 / Obj1_Pt1 Obj1_Pt2 Obj2_Pt1 Obj2_Pt2 Obj1 Obj2 Obj1_Type Obj2_Type Results SS SSLen Count)
;Collinear test adapted from code at: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/colinear-lines/m-p/836033/highlight/true#M61691
(if (and Ent1 Ent2)
(progn
(setq Obj1 (vlax-ename->vla-object Ent1)
Obj2 (vlax-ename->vla-object Ent2)
Obj1_Type (vla-get-objectname Obj1)
Obj2_Type (vla-get-objectname Obj2)
Obj1_Pt1 (vlax-curve-getStartPoint Obj1)
Obj1_Pt2 (vlax-curve-getEndPoint Obj1)
Obj2_Pt1 (vlax-curve-getStartPoint Obj2)
Obj2_Pt2 (vlax-curve-getEndPoint Obj2)
)
(if (and Obj1_Pt1 Obj1_Pt2 Obj2_Pt1 Obj2_Pt2)
(progn
(cond
((and (= Obj1_Type "AcDbArc") (= Obj2_Type "AcDbArc"))
(if (equal (distance (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (vla-get-center Obj1))) (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (vla-get-center Obj2)))) 0)
(progn
(setq Results T)
)
)
)
((or (= Obj1_Type "AcDbPolyline") (= Obj2_Type "AcDbPolyline"))
(setq Results T); Needs to be adjusted to determine if segments, etc. are colinear
)
(T
(setq Results
(and
(null (inters Obj1_Pt1 Obj1_Pt2 Obj2_Pt1 Obj2_Pt2 nil))
(null (inters Obj1_Pt1 Obj1_Pt2 Obj1_Pt1 Obj2_Pt2 nil))
)
)
)
)
)
)
)
)
Results
)
;End Supporting Functions
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object)) ; Sets the drawing based variables
*modelspace* (vla-get-ModelSpace *thisdrawing*)
*paperspace* (vla-get-PaperSpace *thisdrawing*)
*activespace* (vlax-get-property *thisdrawing* (nth (vla-get-ActiveSpace *thisdrawing*)'("PaperSpace" "ModelSpace")))
)
(vla-StartUndoMark *thisdrawing*)
(if SS
(progn
(setq SSLen (sslength SS)
Count1 0
)
(while (< Count1 SSLen)
(setq Ent1 (ssname SS Count1)
Count2 0
SS2Len (sslength SS)
)
(while (< Count2 SS2Len)
(setq Ent2 (ssname SS Count2))
(if (and (and Ent1 Ent2) (/= Count1 Count2))
(progn
(if (setq Pts (collinear Ent1 Ent2))
(progn
(setq Ent1_Type (cdr (assoc 0 (entget Ent1))))
(if (or (= Ent1_Type "LWPOLYLINE") (= Ent1_Type "POLYLINE"))
(progn
(setq Old_PeditAccept (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(command "._pedit" "_m" Ent1 Ent2 "" "_Join" "_Joint" "_Both" (* (getvar "dimscale") 0.25) "") ; Needs adjustment to make fuzz size actual gap size
(setvar "peditaccept" Old_PeditAccept)
(command "._-overkill" Ent1 "" "_Ignore" "_None" "_tOlerance" (* (getvar "dimscale") 0.25) "_P" "_B" "_Y" "_Y" "_T" "_Y" "_E" "_Y" "_A" "_Y" "_Done")
)
(progn
(command "._join" Ent1 Ent2 "")
)
)
(ssdel Ent2 SS)
(setq SSLen (sslength SS)
SS2Len (sslength SS)
)
)
)
)
)
(setq Count2 (+ Count2 1))
)
(setq Count1 (+ Count1 1))
)
)
)
(princ)
(vla-EndUndoMark *thisdrawing*)
)
;End Functions
