OK,here is the updated code.
Still has an issue with lines to be trimmed that run through the Z part
of the pline. If the line to be trimmed runs through 3 times some of the
line may not be trimmed. There also an issue with lines that just protrude
into the trim space but are closer that the trim distance. i set the trim
distance at (break line length / 70) which works out to be 36/70= 0.51
That is 1/2 inch on a 36 inch break line.
If this is not close enough I'll change it.
;;; Lisp to draw Single or Double "Z" Break Lines
;;; © A.Henderson 2002
;;;
;;; Modified By Charles Alan Butler 10/02/2004
;;; To allow any angle and to trim lines that
;;; do not run through both break symbols
;;;
(defun c:dz (/ oldlay oldotho oldosmode ztype dist ang
e1 e2 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)
;; return vertex list by MP
(defun cdrs (key lst / pair rtn)
(while (setq pair (assoc key lst))
(setq rtn (cons (cdr pair) rtn)
lst (cdr (member pair lst))
)
)
(reverse rtn)
) ; defun
;; set osnaps ON/OFF
(defun setosnaps (value) ; value = "ON" or default to "OFF"
(if value
(setq value (strcase value))
)
(cond
((or (and (= value "ON") (>= (getvar "osmode") 16383))
(and (/= value "ON") (<= (getvar "osmode") 16383))
)
(setvar "osmode" (boole 6 (getvar "osmode") 16384))
)
)
); defun
;; Start of routine ==================================
;; Save settings
(setq oldlay (getvar "clayer")
oldortho (getvar "orthomode")
oldosmode (getvar "osmode")
) ;_ end of setq
;; I use current layer - CAB
;;(command ".layer" "make" "Z-Line" "Colour" "41" "" "")
(initget "S D")
(setq ztype (getkword "\n Single or Double -^v-^v- ? (S or D) <S>"))
(setosnaps "ON") ; force on
;;===========================================
(if (and (setq p1 (getpoint "Starting point of break line : "))
(setq p6 (getpoint p1 "End point of break line : "))
)
(progn;===========================================
(setvar "plinewid" 0)
(cond
((/= ztype "D") ; default to single
(setq dist (distance p1 p6)
ang (angle p1 p6)
p2 (polar p1 ang (* 0.4167 dist))
p5 (polar p1 ang (* 0.5833 dist))
p3 (polar p2 (+ 1.25664 ang) (* 0.1667 dist))
p4 (polar p5 (+ 4.39824 ang) (* 0.1667 dist))
) ;_ end of setq
(setosnaps "OFF") ; force off
(command "pline" p1 p2 p3 p4 p5 p6 "") ; Draw the Z-Line
) ;_ end cond "S"
;;===========================================
((= ztype "D")
(setq p10 p6
dist (/ (distance p1 p6) 2.0)
ang (angle p1 p6)
p2 (polar p1 ang (* 0.4167 dist))
p5 (polar p1 ang (* 0.5833 dist))
p3 (polar p2 (+ 1.25664 ang) (* 0.1667 dist))
p4 (polar p5 (+ 4.39824 ang) (* 0.1667 dist))
p6 (polar p5 ang (* 0.8334 dist))
p9 (polar p6 ang (* 0.1661 dist))
p7 (polar p6 (+ 1.25664 ang) (* 0.1667 dist))
p8 (polar p9 (+ 4.39824 ang) (* 0.1667 dist))
) ;_ end of setq
(setosnaps "OFF") ; force off
(command "pline" p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 "") ; Draw the Z-Line
) ;_ end cond
) ; end cond stmt
;; Position the second break line
(setq e1 (entlast))
(command ".pedit" e1 "L" "ON" "")
(command ".copy" e1 "" (getvar "lastpoint") pause)
(setq e2 (entlast))
;; trim function
(initget "Y N")
(setq ans (getkword "\n Do you wish to trim the lines now ? (Y or N) <N>"))
(if (= ans "Y")
(progn
(setq evl1 (cdrs 10 (entget e1)) ; ent vertex list
evl2 (cdrs 10 (entget e2))
ang1 (angle p1 (car evl2))
ang2 (angle (car evl2) p1)
)
(setq lst '()
dist (/ dist 70.0)
)
(foreach x evl1
(setq lst (cons (polar x ang1 1) lst))
)
(foreach x (reverse evl2)
(setq lst (cons (polar x ang2 1) lst))
)
(setosnaps "OFF") ; force off
(command ".trim" e1 e2 "" "F")
(apply 'command lst)
(command "" "")
) ; progn
) ;_ endif
) ; progn
) ; endif
;;================
;; Exit sequence
;;================\
;; Restore settings
;; I use current layer - CAB
;;(command ".layer" "set" oldlay "")
(setvar "orthomode" oldortho)
(setvar "osmode" oldosmode)
(princ)
) ;_ end of defun
(prompt
"\nDouble Break Symbol Creator loaded. Type DZ to run it."
)
(princ)
