;;; Fillet Polyline by flipped Arc and create single polyline from it in one click
;;; Based on Kent Cooper and other existing routines with great respect to authors
;;; Modified by Igal Averbuh 2016 (added option for polyline fillet and recreate single polyline from fillet lines and flipped arc)

(vl-load-com)

(defun c:pj nil (c:PolyJoin))

(defun c:PolyJoin ( / *error* _StartUndo _EndUndo vl ov ss )

(defun *error* ( msg )
(if ov (mapcar 'setvar vl ov))
(if doc (_EndUndo doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)

(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)

(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(_StartUndo doc)

(setq vl '("CMDECHO" "PEDITACCEPT") ov (mapcar 'getvar vl))
(mapcar 'setvar vl '(0 1))
(princ "\nSelect Flipped Arc and fillet Lines to join it to one polyline")
(if (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
(command "_.pedit" "_M" ss "" "_J" "500" "")
)

(mapcar 'setvar vl ov)
(_EndUndo doc)
(princ)
)
(vl-load-com) (princ)

(princ "\nFillet 2 lines by flipped radius.\nEnter FX to Invoke")
(defun c:Fx ( / enlast)

(setvar 'filletrad
(cond ((getdist (strcat "\nSpecify fillet radius : ")))
((getvar 'filletrad))
)
)

(if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,POLYLINE"))))
(command "_.explode" ss "")
)

(setq enlast (entlast))
(initcommandversion)
(command "_.FILLET" "l")
(while (> (getvar 'CMDACTIVE) 0)
(command PAUSE))
(if (and (not (equal enlast (setq enlast (entlast))))
(= "ARC" (cdr (assoc 0 (entget enlast)))))
(command "_.MIRROR"
enlast ""
"_none" (vlax-curve-getStartPoint enlast)
"_none" (vlax-curve-getEndPoint enlast)
"_Y")
(princ "\nFlipping failed. No arc created or wrong object "))
(princ)
(c:pj)
)

Advertisements