管道破裂符号lisp需要e
大家好，下面为管道和钢型材绘制了断裂标记-它仅适用于线条。如何将其更改为同时处理多段线？？
这是一个老Lisp程序，已经坐了一段时间了。
干杯
(defun c:SHS () (endsym "SHS") (princ))
(defun c:CHS () (endsym "CHS") (princ))
(defun drchs (en1 pt1 en2 pt2 dpt / a12 d12 hd12 qd12 bulge mpt a1p a2p)
(setq a12 (angle pt1 pt2)
d12 (distance pt1 pt2)
hd12 (* 0.5 d12)
qd12 (* 0.25 d12)
bulge (* 0.35 qd12)
mpt (polar pt1 a12 hd12)
)
(if (is_left pt1 pt2 dpt)
(progn
(setq a1p (polar (polar pt1 a12 qd12) (+ a12 (dtr 90)) bulge)
a2p (polar (polar mpt a12 qd12) (+ a12 (dtr 90)) bulge)
)
)
(progn
(setq a1p (polar (polar pt1 a12 qd12) (- a12 (dtr 90)) bulge)
a2p (polar (polar mpt a12 qd12) (- a12 (dtr 90)) bulge)
)
)
)
(command "PLINE" pt1 "A" "S" a1p mpt pt2 "S" a2p mpt "")
)
;To draw a break symbol
(defun endsym (typ / ce en1 en2 pt1 pt2 ed1 ed2 mpt lay lt col draw dpt)
(setq typ (strcat typ))
(princ (strcat "\n" typ " End"))
(setq *olderror* *error* *error* *brkerr*)
(setq ce (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq en1 (pickline "Pick point on 1st line" "QUI,NEA")
en2 (pickline "Pick 2nd line" "QUI,PER")
pt1 (cadr en1) en1 (car en1)
pt2 (cadr en2) en2 (car en2)
ed1 (entget en1) ed2 (entget en2)
mpt (polar pt1 (angle pt1 pt2) (* 0.5 (distance pt1 pt2)))
)
(grdraw pt1 pt2 -1) (setq draw T)
(initget 1)
(setq dpt (getpoint "\nPick side to break: " mpt))
(grdraw pt1 pt2 -1) (setq draw nil)
(setq lay (getvar "CLAYER") lt (getvar "CELTYPE") col (getvar "CECOLOR"))
(setvar "CLAYER" (dxf 8 ed1))
(setvar "CELTYPE" (if (setq elt (dxf 6 ed1)) elt "BYLAYER"))
(setvar "CECOLOR" (if (setq ec (dxf 62 ed1)) (itoa ec) "BYLAYER"))
(command ".UNDO" "GROUP")
(trimline ed1 pt1 pt2 dpt)
(trimline ed2 pt2 pt1 dpt)
(cond
((= typ "SHS") (drshs ed1 pt1 ed2 pt2 dpt))
((= typ "CHS") (drchs ed1 pt1 ed2 pt2 dpt))
(T (princ (strcat "\nInvalid end type: " typ)))
)
(command ".UNDO" "END")
(setvar "CLAYER" lay)
(setvar "CELTYPE" lt)
(setvar "CECOLOR" col)
(setvar "CMDECHO" ce)
(setq *error* *olderror* *olderror* nil)
(princ)
)
;Tests to see if a point is to the left of a line.The first two points
;represent the sp and ep of the line and pt is the point to test.If pt
;is ON the line then this says it is NOT left.Returns T or nil
(defun is_left (sp ep pt / ase aes asp)
(setq ase (angle sp ep)
aes (angle ep sp)
asp (angle sp pt)
)
(cond
((= ase 0.0) (if (< asp pi) T nil))
((= ase pi) (if (> asp pi) T nil))
((< ase pi) (if (and (> asp ase) (< asp aes)) T nil))
(T (if (or (> asp ase) (< asp aes)) T nil))
)
)
(defun drshs (ed1 pt1 ed2 pt2 dpt / a12 d12 pt3 pt4)
(setq a12 (angle pt1 pt2) d12 (distance pt1 pt2))
(if (is_left pt1 pt2 dpt)
(setq pt3 (polar pt2 (- a12 (* 0.5 pi)) (* d12 0.25)))
(setq pt3 (polar pt2 (+ a12 (* 0.5 pi)) (* d12 0.25)))
)
(setq pt4 (polar pt1 (angle pt1 pt3) (* 0.5 (distance pt1 pt3))))
(command "LINE" pt1 pt3 "")
(command "LINE" pt2 pt4 "")
)
(defun trimline (ed pt1 pt2 dpt / sp)
(setq sp (dxf 10 ed))
(if (is_left pt1 pt2 dpt)
(if (is_left pt1 pt2 sp)
(setq ed (chged ed 10 pt1))
(setq ed (chged ed 11 pt1))
)
(if (is_left pt1 pt2 sp)
(setq ed (chged ed 11 pt1))
(setq ed (chged ed 10 pt1))
)
)
(entmod ed)
)
;To pick a line using OSNAP mode os (string).Returns the same as entsel
(defun pickline (prm os / oldos en ed typ)
(if (not os) (setq os "NONE"))
(while (not en)
(if (setq en (entsel (strcat "\n" prm ": ")))
(progn
(setq typ (dxf 0 (entget (car en))))
(if (/= typ "LINE")
(progn
(setq en nil)
(princ (strcat "\nInvalid selected entity: " typ))
)
)
)
)
)
(list
(car en)
(setvar "LASTPOINT" (osnap (cadr en) os))
)
)
(defun *brkerr* (msg)
(if draw (grdraw pt1 pt2 -1))
(if ce (setvar "CMDECHO" ce))
(if pw (setvar "PLINEWID" pw))
(if lay (setvar "CLAYER" lay))
(if col (setvar "CELTYPE" col))
(if lt (setvar "CECOLOR" lt))
(setq *error* *olderror* *olderror* nil)
(princ)
)
(defun dxf (code ed)
(cdr (assoc code ed))
)
(defun dtr (ang)
(* pi (/ ang 180.0))
)
(defun rtd (ang)
(* 180.0 (/ ang pi))
)
(defun dwgscl (d)
(* d (getvar "DIMSCALE"))
)
(defun chged (ed code new)
(subst (cons code new) (assoc code ed) ed)
)
(princ)
页:
[1]