The routine allows the user to select the span for each end of the Polyline ellipse while making the leader.
A Stanadard Ellipse just doesnt work for that.
; EL.LSP VER 2, AUGUST 13, 1997
;
; A program by Grant A. Vogl
;
; EL is designed to make a leader with an ellipse, while
; giving the user the option to "stretch" the ellipse to
; another line.
(defun C:ellipseleader ( / curosnap ortho cmd c1 p2 ds cl elev ang1
break1 break2 end1 pell el1 line1 pickp3
p3 ang2 line2 pickline ent entpt1 entpt2
c2 line2pick name ltr line break3 break4
end2 el2 line3 line4 vert horz intvert
inthorz p2horz p2vert p2new p3new *error*
)
;; Added by Chris Moor ====================================================
(setq ds (getvar "dimscale"))
(setq usersnaps (getvar "osmode")) ; -----------------------Get User Osmode Settings
(setq userlayer (getvar "clayer")) ; -----------------------Get User Layer Settings
;(setq userpol (getvar "polarang")) ; -----------------------Get User Polar Angle Settings
(setq userauto (getvar "autosnap")) ; -----------------------Get User Polar Mode Settings
;; Added by Chris Moor ====================================================
; Error condition for exit to restore osnaps -------------------------------------------------------------------------------
(DEFUN *error* (errormessage /)
(COND ((NOT errormessage)) ; no error, do nothing
((VL-POSITION (STRCASE errormessage T) ; cancel
'("console break"
"function cancelled"
"quit / exit abort"
)
)
)
(setvar "osmode" usersnaps)
(princ "\n Osnaps returned.") ; return osnaps
((PRINC (STRCAT "\nApplication Error: "
(GETVAR "errno")
" :- "
errormessage
)
)
)
)
(command "osmode" usersnaps) ; -----------------------Return User Osmode Settings
(command "autosnap" userauto) ; -----------------------Return User Polar Mode Settings
(command "clayer" userlayer) ; -----------------------Return User Layer Settings
(command "polarang" userpol) ; -----------------------Return User Polar Angle Settings
(princ "\n Ellipse Leader Osnaps & Layer Returned.l --Error Catch--")
)
; Error condition for exit to restore osnaps -------------------------------------------------------------------------------
(command "undo" "begin")
; Save system variables.
(setq curosnap (getvar "osmode"))
(setq ortho (getvar "orthomode"))
(setq cmd (getvar "cmdecho"))
; Prompt the user to begin the first leader line.
(command "cmdecho" 0)
(command "osnap" "nea")
(princ "\nLEADER with ellipse.")
(setq c1 (getpoint "\nPick beginning of leader <return to exit>: "))
; If the user picks the first point, prompt the user to end the
; first leader line. Otherwise, exit the "if" statement.
(if c1
(progn
(command "osnap" "")
(command "ortho" "off")
(setq c1 (list (car c1) (car (cdr c1)) 0))
(setq p2 (getpoint c1 "\nPick end of leader line <return to exit>: "))
; If the user picks the second point, draw the first leader line
; and the ellipse, and prompt the user to end the second leader
; line. Otherwise, exit the "if" statement.
(if p2
(progn
(setq p2 (list (car p2) (car (cdr p2)) 0))
(setq ds (getvar "dimscale"))
(setq cl (getvar "clayer"))
(setq elev (getvar "elevation"))
(command "elevation" 0)
; The first leader line has a minimum length based on the
; dimscale.
(setq ang1 (angle c1 p2))
(if (< (distance c1 p2) (* ds (/ 13 96.0)))
(setq p2 (polar c1 ang1 (* ds (/ 13 96.0))))
)
(setq break1 (polar c1 (+ ang1 (/ pi 2)) (/ ds 48.0)))
(setq break2 (polar c1 (- ang1 (/ pi 2)) (/ ds 48.0)))
(setq end1 (polar c1 ang1 (/ ds 24.0)))
(command "layer" "m" "G-ANNO-TEXT" "")
(setq pell (getvar "pellipse"))
(command "pellipse" 1)
(command "ellipse" break1 break2 end1)
(setvar "pellipse" pell)
(setq el1 (entlast))
(command "line" end1 p2 "")
(setq line1 (entlast))
(setvar "clayer" cl)
(setvar "elevation" elev)
; While the user continues picking a non-horizontal elbow,
; keep asking the user to pick the end of the elbow. If the
; user picks the third point, draw the short horizontal
; line, called an elbow, hook line, dogleg, or landing.
; Otherwise, exit the "while" statement.
(setq pickp3 1)
(while (= pickp3 1)
(progn
(command "ortho" "on")
(setq p3 (getpoint p2 "\nPick end of elbow <return to exit>: "))
(if (null p3)
(setq pickp3 0)
(if (or (= (angle p2 p3) 0) (= (angle p2 p3) pi))
(progn
(setq pickp3 0)
(setq p3 (list (car p3) (car (cdr p3)) 0))
; The short horizontal line has a minimum length of the text
; height.
(if (< (distance p2 p3) (* ds 0.09375))
(progn
(setq ang2 (angle p2 p3))
(setq p3 (polar p2 ang2 (* ds 0.09375)))
)
)
(command "layer" "m" "G-ANNO-TEXT" "")
(command "line" p2 p3 "")
(setq line2 (entlast))
(setvar "clayer" cl)
)
(princ "\nThe elbow must be horizontal.")
)
)
)
)
; While the user continues to pick an illegitimate entity, keep
; asking the user to pick a line to stretch the ellipse to.
; Otherwise, exit the "while" statement.
(setq pickline 1)
(while (= pickline 1)
(progn
(setq ent (entsel "\nPick a line to stretch ellipse to <return to exit>: "))
(if ent
(progn
; If the entity is a line, find its endpoints and the
; intersection point of the line and the leader line, which
; is the second center point.
(if (= (cdr (assoc 0 (entget (car ent)))) "LINE")
(progn
(setq entpt1 (cdr (assoc 10 (entget (car ent)))))
(setq entpt1 (list (car entpt1) (car (cdr entpt1)) 0))
(setq entpt2 (cdr (assoc 11 (entget (car ent)))))
(setq entpt2 (list (car entpt2) (car (cdr entpt2)) 0))
(setq c2 (inters c1 p2 entpt1 entpt2 [off]))
)
)
; If the entity selected is the elbow, set the variable
; "line2pick" to 1.
(setq line2pick 0)
(if line2
(if (eq (car ent) line2)
(setq line2pick 1)
)
)
; Start the "cond" statement for selecting the case.
(cond
; If the entity is the ellipse, tell the user.
((eq (car ent) el1)
(princ "\nYou have selected the ellipse by mistake.")
)
; If the entity is not a line, tell the user what it is.
((/= (cdr (assoc 0 (entget (car ent)))) "LINE")
(progn
(setq name (cdr (assoc 0 (entget (car ent)))))
(setq name (strcase name ""))
(if (= name "insert")
(setq name "block")
)
(setq ltr (substr name 1 1))
(if (or (= ltr "a") (= ltr "e") (= ltr "i") (= ltr "o") (= ltr "u"))
(setq line "The entity you have selected is an ")
(setq line "The entity you have selected is a ")
)
(princ (strcat "\n" line name ", not a line."))
)
)
; If the line is the elbow, tell the user.
((= line2pick 1)
(princ "\nYou have selected the elbow by mistake.")
)
; If the line is the leader line, tell the user.
((eq (car ent) line1)
(princ "\nYou have selected the leader line by mistake.")
)
; If the first and second center points coincide, tell
; the user.
((equal c1 c2 0.00000001)
(princ "\nYou have selected this line by mistake.")
)
; The first case for stretching the ellipse.
((and (< (distance p2 c2) (distance p2 c1))
(< (distance c1 c2) (distance c1 p2))
(>= (distance c2 p2) (* ds (/ 13 96.0))))
(progn
(entdel el1)
(entdel line1)
(command "elevation" 0)
(command "layer" "m" "G-ANNO-TEXT" "")
(command "pellipse" 1)
(command "ellipse" break2 break1 end1)
(command "break" (entlast) break1 break2)
(setq el1 (entlast))
(setq break3 (polar c2 (- ang1 (/ pi 2)) (/ ds 48.0)))
(setq break4 (polar c2 (+ ang1 (/ pi 2)) (/ ds 48.0)))
(setq end2 (polar c2 ang1 (/ ds 24.0)))
(command "ellipse" break4 break3 end2)
(setvar "pellipse" pell)
(command "break" (entlast) break3 break4)
(setq el2 (entlast))
(command "line" break1 break4 "")
(setq line3 (entlast))
(command "line" break2 break3 "")
(setq line4 (entlast))
(command "line" end2 p2 "")
(setvar "clayer" cl)
(setvar "elevation" elev)
(command "pedit" el1 "j" el2 line3 line4 "" "")
(setq pickline 0)
)
)
; The second case for stretching the ellipse.
((and (< (distance p2 c1) (distance p2 c2))
(< (distance c2 c1) (distance c2 p2)))
(progn
(command "elevation" 0)
(command "break" el1 break1 break2)
(setq el1 (entlast))
(setq break3 (polar c2 (- ang1 (/ pi 2)) (/ ds 48.0)))
(setq break4 (polar c2 (+ ang1 (/ pi 2)) (/ ds 48.0)))
(command "layer" "m" "G-ANNO-TEXT" "")
(command "pellipse" 1)
(command "ellipse" break3 break4 (/ ds 24.0))
(setvar "pellipse" pell)
(command "break" (entlast) break3 break4)
(setq el2 (entlast))
(command "line" break1 break4 "")
(setq line3 (entlast))
(command "line" break2 break3 "")
(setq line4 (entlast))
(setvar "clayer" cl)
(setvar "elevation" elev)
(command "pedit" el1 "j" el2 line3 line4 "" "")
(setq pickline 0)
)
)
; The third case for stretching the ellipse.
(T
(progn
(command "elevation" 0)
(setq vert (polar p2 (/ pi 2) 1))
(setq horz (polar p2 0 1))
(setq intvert (inters p2 vert entpt1 entpt2 [off]))
(setq inthorz (inters p2 horz entpt1 entpt2 [off]))
(if inthorz
(if (> (car p2) (car c1))
(setq p2horz (polar inthorz 0 (* ds (/ 13 96.0))))
(setq p2horz (polar inthorz pi (* ds (/ 13 96.0))))
)
)
(if intvert
(if (> (car (cdr p2)) (car (cdr c1)))
(setq p2vert (polar intvert (/ pi 2) (* ds (/ 13 96.0))))
(setq p2vert (polar intvert (* pi 1.5) (* ds (/ 13 96.0))))
)
)
(cond
((and inthorz intvert)
(if (< (distance p2 inthorz) (distance p2 intvert))
(setq p2new p2horz)
(setq p2new p2vert)
)
)
(inthorz
(setq p2new p2horz)
)
(T
(setq p2new p2vert)
)
)
(setq c2 (inters c1 p2new entpt1 entpt2 [off]))
(setq ang1 (angle c1 c2))
(setq break1 (polar c1 (+ ang1 (/ pi 2)) (/ ds 48.0)))
(setq break2 (polar c1 (- ang1 (/ pi 2)) (/ ds 48.0)))
(entdel el1)
(entdel line1)
(command "layer" "m" "G-ANNO-TEXT" "")
(command "pellipse" 1)
(command "ellipse" break2 break1 (/ ds 24.0))
(command "break" (entlast) break1 break2)
(setq el1 (entlast))
(setq break3 (polar c2 (- ang1 (/ pi 2.0)) (/ ds 48.0)))
(setq break4 (polar c2 (+ ang1 (/ pi 2.0)) (/ ds 48.0)))
(setq end2 (polar c2 ang1 (/ ds 24.0)))
(command "ellipse" break4 break3 end2)
(setvar "pellipse" pell)
(command "break" (entlast) break3 break4)
(setq el2 (entlast))
(command "line" break1 break4 "")
(setq line3 (entlast))
(command "line" break2 break3 "")
(setq line4 (entlast))
(command "line" end2 p2new "")
(setvar "clayer" cl)
(command "pedit" el1 "j" el2 line3 line4 "" "")
(if p3
(progn
(entdel line2)
(setq ang2 (angle p2 p3))
(setq p3new (polar p2new ang2 (* ds 0.09375)))
(if (and (< (distance p2new p3new) (distance p2new p3))
(< (distance p3 p3new) (distance p3 p2new)))
(setq p3new (polar p2new ang2 (abs (- (car p3) (car p2new)))))
)
(command "layer" "m" "G-ANNO-TEXT" "")
(command "line" p2new p3new "")
(setvar "clayer" cl)
)
)
(setvar "elevation" elev)
(setq pickline 0)
)
)
)
)
(setq pickline 0)
)
)
)
)
)
)
)
; Set back system variables and end the program.
;(setvar "orthomode" ortho)
(command "cmdecho" cmd)
(command "orthomode" ortho)
; added today 11/19/07
(command "osmode" usersnaps) ; -----------------------Return User Osmode Settings
(command "autosnap" userauto) ; -----------------------Return User Polar Mode Settings
(command "clayer" userlayer) ; -----------------------Return User Layer Settings
;(command "polarang" userpol) ; -----------------------Return User Polar Angle Settings
(princ "\n Ellipse Leader Osnaps & Layer Returned.--end run--")
(princ)
(command "undo" "end")
)
