;;; By Charles Alan Butler : Last Modified 01/08/04
;;; ArcL.lsp (Arc Leader)
;;; Uses the current layer & MyArrow Arrow head
;;;====== Main Lisp Routine =======
(defun c:ArcL (/ usercmd useros userAngDir loop ptpick Lastpt)
;; error function & Routine Exit
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort")
)
)
(princ (strcat "\nError: " msg))
) ; if
(princ)
) ;
;end error function
;;;=============================================================
;;; Local Functions
;;;=============================================================
(defun makeMyblk (/ ss)
(command "-color" "Red")
(command "line" "0,0" "0,6" "")
(setq ss (ssadd))
(ssadd (entlast) ss)
(command "line" "0,0" "6,0" "")
(ssadd (entlast) ss)
(command "line" "0,0" (polar '(0 0) 0.2618 6) "")
(ssadd (entlast) ss)
(command "line" "0,0" (polar '(0 0) 1.309 6) "")
(ssadd (entlast) ss)
(command "-block" "MyArrow" '(0 0) ss "")
(command "-color" "ByLayer")
) ;defun
;;;=============================================
;;; ArcC Arc Leader with Circle Arrow Head
;;; Uses the current layer & Circle Arrow head
;;;=============================================
(defun ArcC (/ ArcEnt)
(setq ArcEnt (list (entlast) ptpick))
(Command "_.Circle" ptpick 2) ; circle arrow head 2" radius
(command "_trim" (entlast) "" ArcEnt "")
) ; end defun
;;;=============================================
;;; ArcArw Arc Leader with Arrow Type Head
;;; Uses the current layer & Block Arrow head
;;;=============================================
(defun arcArw (/ L_Angle cenpt rad StartAng arcdata
EndAng ArwOffset
)
(setq arcdata (entget (entlast))
cenpt (cdr (assoc 10 arcdata))
rad (cdr (assoc 40 arcdata))
StartAng (cdr (assoc 50 arcdata))
EndAng (cdr (assoc 51 arcdata))
)
;;-------check for cw drawn arc----------
(if (equal (polar cenpt EndAng rad) ptpick 0.1)
(progn
(setq L_Angle (+ EndAng (* pi 1.25)) ;start ang for cw
)
) ;progn
(setq L_Angle (- StartAng (* pi 1.75))) ;start ang for ccw
) ;if
;; ---------- Arrow Head ---------------
(if (not (tblsearch "block" "MyArrow"))
(MakeMyBlk)
)
(setq ang (* 180.0 (/ L_Angle pi)))
(Command "_.insert" "MyArrow" "S" 1 ptpick ang) ; arrow head
); end defun
;;;=============================================================
;;;=============================================================
;;; Routine Starts Here
;;;=============================================================
;;;=============================================================
(princ "\n")
(princ "\n Arc Leader - Version 1.2")
(princ "\n")
;;; ------- Some Housekeeping ------------------
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
(setq userANGDIR (getvar "angdir"))
(setvar "angdir" 0)
(if (not ArType) ; GET Arrow Type FOR THE FIRST TIME IN THE ROUTINE
(progn
(setq ArType "")
(while (not (member ArType (list "Circle" "Arrow")))
(INITGET 1 "Circle Arrow")
(setq ArType (getkword "\nArrow head to use, [A]rrow or [C]ircle: "))
)
)
) ; endif
;; loop until user enters point or "C" or "A"
(setq loop T)
(while loop
(initget 1 "Circle Arrow")
(setq
ptpick (getpoint
(strcat "\nPick leader start point or [Circle / Arrow]:<"
ArType
">"
)
)
)
(cond
((= (type ptpick) 'LIST) ; point picked
(setq loop nil) ; exit loop
)
((or (= ptpick "Circle") (= ptpick "Arrow"))
(setq ArType ptpick)
)
(T (alert "Pick point or enter C or A"))
)
) ; end while
(command "arc" ptpick pause pause)
(if (= "ARC" (cdr (assoc 0 (entget (entlast)))))
(progn ; arc created
(setq Lastpt (getvar "lastpoint"))
(cond
((= ArType "Arrow")
(ArcArw)
)
((= ArType "Circle")
(ArcC)
)
)
)
) ; endif
;;;========== Exit Sequence ============
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
(setvar "angdir" userangdir)
(princ)
(list ptpick Lastpt) ; return the start & end point of the arc
) ; end defun
(prompt "\nArc Leader Loaded, Type ArcL to run")
(princ)
;;;========== End of Routine ============
;;;/////////////
;;; EOF
;;;\\\\\\\\\\\\\
