 - ;;;原来找的源码
- (defun C:jdx (/ ang dis lay pt1 pt2 pt3 pt4 pt5 pt6 scale x1)
- (defun *error* (msg)
- (SETVAR "clayer" lay)
- (if (and
- msg
- (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,"))
- )
- (princ msg)
- (princ)
- )
- )
- (setvar "CMDECHO" 0)
- (setq lay (getvar "clayer"))
- (command "color" "bylayer")
- (command "layer" "m" "截断线" "c" "m" "截断线" "")
- (setq scale (getreal "\n截断线宽度 <300>:"))
- (if (= scale nil)
- (setq scale 300)
- )
- (setq pt1 (getpoint "\n第一点:"))
- (setq pt2 (getpoint pt1 "\n第二点:"))
- (setq ang (angle pt1 pt2))
- (setq dis (distance pt1 pt2))
- (setq x1 (/ (- dis (* 2 scale)) 2))
- (setq pt3 (polar pt1 ang x1))
- (setq pt4 (polar pt1 ang (+ x1 (* 2 scale))))
- (setq pt5 (polar pt3 (+ ang 1.32582) (* 2.0616 scale)))
- (setq pt6 (polar pt4 (- ang 1.81577) (* 2.0616 scale)))
- (command "pline" pt1 "w" "0" "0" pt3 pt5 pt6 pt4 pt2 "")
- (*error* "")
- (princ)
- )
|