For some odd reason, the horizontal (lead) line always draws towards the right (0 degrees) even if the angle direction is towards 180. Any chance of getting this to draw at 0 or 180 depending on pt2's direction?
Here is the complete lisp:
;;===================================================================
;; Function to start each routine.
;;===================================================================
(defun st_art (/ UN_DO)
(if (notrans) (progn ;;if no command is active
;;set error function
(setq RESET T
OLDERR *error*
*error* FUN_ERR
UN_DO (getvar "UNDOCTL")
)
(varset "cmdecho" 0)
;;set undo controlls
(cond
((= UN_DO 0)
(command ".undo" "All")
)
((= UN_DO 3)
(command ".undo" "c" "All")
)
)
(command ".undo" "g")
));;end notrans
)
;;===================================================================
;; Function to set variable and save original setting.
;;===================================================================
(defun varset (VAR VAL)
(if (not (assoc VAR VARLIST))
(setq VARLIST (cons (list VAR (getvar VAR)) VARLIST))
)
(setvar VAR VAL)
)
;;===================================================================
;; Function to restore original drawing variable settings.
;;===================================================================
(defun ex_it ()
(command ".undo" "e")
(repeat (LENGTH VARLIST)
(setvar (caar VARLIST) (cadar VARLIST))
(setq VARLIST (cdr VARLIST))
)
(setq *error* OLDERR
OLDERR nil
RESET nil)
(command nil nil)
(princ)
)
;;===================================================================
;; Function for Error Handler
;;===================================================================
(defun fun_err (MSG)
(If (/= MSG "Function cancelled")
(princ MSG)
)
(command nil nil)
(command ".UNDO" "e")
(If RESET
(progn
(princ "\nUndoing...")
(command ".undo" 1)
)
)
(ex_it)
)
;;===================================================================
;; Ukword
;;===================================================================
(defun ukword (bit kwd msg def / inp)
(if (and def (/= def "")) ;Test both nil and null string
(setq msg (strcat "\n" msg "<" def ">: ") ;String'em with default
bit (- bit (boole 1 bit 1)) ;A default and no null bit code
);setq ;conflict, so reduce BIT by 1
;if 1 bit is set, to allow null
(if (= " " (substr msg (strlen msg) 1)) ;No def, if last char is space
(setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))
;Then strip space
(setq msg (strcat "\n" msg ": ")) ;Else msg is OK
) );if,if
(initget bit kwd) ;Initialize the key words
(setq inp (getkword msg)) ;and use the GET function
(if inp inp def) ;Compare results, return appropriate value
)
;;===================================================================
;; Arrow Head
;;===================================================================
(defun C:ALDR ( / pt1 pt2 pt3 args asz txsz)
(st_art)
(if (getvar "PLINETYPE") (VARSET "PLINETYPE" 0)) ;if ACAD14 set to polyline
(varset "OSMODE" 0) ;Turn osmode off
(varset "ORTHOMODE" 0) ;Turn ortho off
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL) ;Creates/sets annotation layer
;if it doesn't exist
;get start point of arrow head, a point for 1st line segment
(setq asz (* (getvar "TEXTSIZE") 1.143)) ;calc arrow head size
(setq pt1 (upoint 1 "" "Pick arrow head point" nil nil)
pt2 (upoint 1 "" "To point" nil pt1) ;get start point of arrow head,
pt3 (polar pt1 (angle pt1 pt2) asz) ;a point for 1st line segment
);setq
;draw arrow head and 1st line segment
(command "_.PLINE" pt1 "_W" "0" (* 0.3333 asz) pt3 "_W" "0" "0" pt2)
;loop for additional line segments or, until ENTER is pressed
(while (setq pt2 (getpoint "\nTo point: " pt2))
(command pt2)
);end while
;;add a horizontal leader
(progn
(setq pt2 (getvar "LASTPOINT")
txsz (getvar "TEXTSIZE")
);end setq
(if (> (car pt2) (car pt1))
(setq pt2 (polar pt2 0 txsz))
(setq pt2 (polar pt2 pi txsz))
)
)
(command pt2)
(command "") ;End pline
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:ALDR
;;===================================================================
;; Ellipse
;;===================================================================
(defun c:ELDR (/ pt1 pt2 pt3 pt4 pt5 X AR AR2 en e2 txsz)
(st_art)
(if (getvar "PLINETYPE") (VARSET "PLINETYPE" 0)) ;if ACAD14 set to polyline
(if (getvar "PELLIPSE") (VARSET "PELLIPSE" 1)) ;if ACAD14 set to polyline
(varset "OSMODE" 0)
(varset "ORTHOMODE" 0)
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL)
;if it doesn't exist
;get start point of ellipse, a point for 1st line segment
(setq pt1 (upoint 1 "" "\nPick center of ellipse" nil nil))
(setq pt3 (upoint 1 "" "\nPick elbow location." nil pt1)
X (* (getvar "TEXTSIZE") 1.143)
AR (angle pt1 pt3)
AR2 (+ AR (/ pi 2))
pt2 (polar pt1 AR X)
pt5 (polar pt1 AR2 (/ X 2))
)
(varset "REGENMODE" 0)
(varset "SPLINESEGS" 12)
(command "_.ellipse" "c" pt1 pt2 pt5)
(setq en (entlast)
pt4 (dxf 10 (entget (setq e2 (entnext en))))
pt5 (dxf 10 (entget (entnext e2)))
)
(command "_.break" en pt4 pt5)
(setq en (entlast))
(command "_.pline" pt2 "_W" "0" "0" pt3)(setq pt2 pt3)
;;loop for additional line segments or, until ENTER is pressed
(while (setq pt2 (getpoint "\nTo point:" pt2))
(command pt2)
);end while
;;add a horizontal leader
(progn
(setq pt2 (getvar "LASTPOINT")
txsz (getvar "TEXTSIZE")
);end setq
(if (> (car pt2) (car pt1))
(setq pt2 (polar pt2 0 txsz))
(setq pt2 (polar pt2 pi txsz))
)
)
(command pt2)
(command "") ;End pline
(command "_.pedit" (entlast) "_J" en (entlast) "" "")
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:ELDR
;;===================================================================
;; Open Arrow
;;===================================================================
(defun C:OLDR (/ pt1 pt2 aang asz pw ang p2 p3 p4 p5 p6 args)
(st_art)
(if (getvar "PLINETYPE") (VARSET "PLINETYPE" 0)) ;if ACAD14 set to polyline
(varset "OSMODE" 0) ;Turn osmode off
(varset "ORTHOMODE" 0) ;Turn ortho off
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL) ;Creates/sets annotation layer
;if it doesn't exist
;get start point of arrow head, a point for 1st line segment
(setq pt1(upoint 1 "" "Pick arrow head point" nil nil)
pt2(upoint 1 "" "To point" nil pt1)
aang(/ pi 4)
asz(*(* (getvar "TEXTSIZE") 1.143)(cos aang))
ang(angle pt1 pt2)
pw (* (getvar "DIMSCALE") 0.008)
p2(polar pt1 (+ ang aang) asz)
p3(polar p2 (+ ang pi) pw)
p4(polar p3 (+ ang aang pi) asz)
p5(polar p4 (- ang aang) asz)
p6(polar p5 ang pw)
);end setq
;;draw arrow head and first line segment
(command "_.PLINE" pt1 "_W" "0" "0" p2 p3 p4 p5 p6 pt1 p4 pt2)
;;loop for additional line segments or, until ENTER is pressed
(while (setq pt2 (getpoint "\nTo point: " pt2))
(command pt2)
);end while
;;add a horizontal leader
(progn
(setq pt2 (getvar "LASTPOINT")
txsz (getvar "TEXTSIZE")
);end setq
(if (> (car pt2) (car pt1))
(setq pt2 (polar pt2 0 txsz))
(setq pt2 (polar pt2 pi txsz))
)
)
(command pt2)
(command "") ;End pline
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:OLDR
;;;================================================================================
;;; Dot
;;;================================================================================
(defun C:DLDR (/ pt3 r ang)
(st_art)
(if (getvar "PLINETYPE") (setvar "PLINETYPE" 0)) ;if ACAD14 set to polyline
(setvar "OSMODE" 0) ;Turn osmode off
(setvar "ORTHOMODE" 0) ;Turn ortho off
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL) ;Creates/sets annotation layer
;if it doesn't exist
;get start point of dot, & point for 1st line segment
(setq sca (getvar "dimscale"))
(setq pt1 (getpoint "Pick arrow head point")
pt2 (getpoint pt1 "To point")
asz (* sca 0.125)
r (* sca 0.021)
ang (angle pt1 pt2)
pt3 (polar pt1 ang r)
) ;end setq. Start pline command
(command "_.PLINE" pt3 "W" r r "A" "CE" pt1 "A" "359" "D" pt2 pt3 "L" "W" "0" "0" pt2)
;;loop for additional line segments or, until ENTER is pressed
(while (setq pt2 (getpoint "\nTo point: " pt2))
(command pt2)
) ;end while
;;add a horizontal leader
(progn
(setq pt1 (getvar "LASTPOINT")
pt2 (osnap pt1 "_quick,_midp")
);end setq
(if (> (car pt1) (car pt2))
(setq pt2 (polar pt1 0 asz))
(setq pt2 (polar pt1 pi asz))
)
)
(command pt2)
(command "") ;End pline
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:DLDR
;;;================================================================================
;;; Bubble
;;;================================================================================
(defun C:BLDR (/ pt3 r ang)
(st_art)
(if (getvar "PLINETYPE") (setvar "PLINETYPE" 0)) ;if ACAD14 set to polyline
(setvar "OSMODE" 0) ;Turn osmode off
(setvar "ORTHOMODE" 0) ;Turn ortho off
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL) ;Creates/sets annotation layer
;if it doesn't exist
;get start point of bubble, & point for 1st line segment
(setq sca (getvar "dimscale"))
(setq pt1 (getpoint "Pick bubble center point"))
(setq cp1 (getdist pt1 "Specify radius of circle:"))
(command "_.CIRCLE" pt1 cp1)
(setq e1 (entlast)
pt2 (getpoint pt1 "To point")
asz (* sca 0.125)
r cp1
ang (angle pt1 pt2)
pt3 (polar pt1 ang r)
);end setq.
(command "_.ERASE" e1 "") ;Erase circle & start pline command
(command "_.PLINE" pt3 "W" "0" "0" "A" "CE" pt1 "A" "359" "D" pt2 pt3 "L" pt2)
;;loop for additional line segments or, until ENTER is pressed
(while (setq pt2 (getpoint "\nTo point: " pt2))
(command pt2)
) ;end while
;;add a horizontal leader
(progn
(setq pt1 (getvar "LASTPOINT")
pt2 (osnap pt1 "_quick,_midp")
);end setq
(if (> (car pt1) (car pt2))
(setq pt2 (polar pt1 0 asz))
(setq pt2 (polar pt1 pi asz))
)
)
(command pt2)
(command "") ;End pline
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:BLDR
;;;================================================================================
;;;Thickline
;;;================================================================================
(defun C:TLDR ( / pt3 asz)
(st_art)
(if (getvar "PLINETYPE") (setvar "PLINETYPE" 0)) ;if ACAD14 set to polyline
(setvar "OSMODE" 0) ;Turn osmode off
(setvar "ORTHOMODE" 1) ;Turn ortho on
(setq clayr (getvar "CLAYER"))
(mk_lyr "-TXT" "132" NIL) ;Creates/sets annotation layer
;if it doesn't exist
;get start point of line, & point for 1st line segment
(setq asz (* sca 0.04167))
(setq pt1 (upoint 1 "" "Pick start point of thick line" nil nil)
pt2 (upoint 1 "" "Pick end point of thick line" nil pt1)
pt3 pt2
);end setq
;draw 1st line segment
(command "_.PLINE" pt1 "_W" asz asz pt3 "_W" "0" "0" pt2)
;loop for additional line segments or, until ENTER is pressed
;pt1 and pt2 are the last two vertices
(while (setq pt2 (getpoint "\nTo point: " pt2))
(command pt2)
);end while
(progn
(setq pt2 (getvar "LASTPOINT")
pt1 (osnap pt2 "_quick,_midp")
);end setq
)
(command "") ;End pline
(command "_.UNDO" "e") ;The pline can stay now if user cancels
(setvar "clayer" clayr)
(ex_it)
(princ)
)
;end defun C:TLDR
;;;================================================================================
;;; Function
;;;================================================================================
(defun c:LDR ()
(initget 6 "A O E D B T")
(setq ansx (ukword 1 "Arrow head, Open arrow, Ellipse, Dot, Bubble, Thickline"
"Arrow head, Open arrow, Ellipse, Dot, Bubble, Thickline? "
"Arrow"))
(if (or (= ansx "A") (= ansx "A"))
(setq ansx (strcat "A"))
)
(if (or (= ansx "O") (= ansx "O"))
(setq ansx (strcat "O"))
)
(if (or (= ansx "E") (= ansx "E"))
(setq ansx (strcat "E"))
)
(if (or (= ansx "D") (= ansx "D"))
(setq ansx (strcat "D"))
)
(if (or (= ansx "B") (= ansx "B"))
(setq ansx (strcat "B"))
)
(if (or (= ansx "T") (= ansx "T"))
(setq ansx (strcat "T"))
)
(cond ((= ansx "A") (C:ALDR))
((= ansx "O") (C:OLDR))
((= ansx "E") (C:ELDR))
((= ansx "D") (C:DLDR))
((= ansx "B") (C:BLDR))
((= ansx "T") (C:TLDR))
((= ansx "Arrow") (C:ALDR))
)
(princ)
)
