天正引出标注lisp_【源码分享】无聊了模仿天正逐点标注 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 模仿 - Powered by Discuz...

[code="lisp]

;;;连续尺寸对齐标注

(defun c:gps_dim_dx(/ l1 l2 l3 l4 l5 b c d1 d2 e1 e2 x3 x4 x5 y3 y4 y5 alf)

(setq l1 (getpoint "\n标注偏移开始点:"))

(setq l2 (getpoint l1 "\n标注线位置:"))

(setq l3 (getpoint "\n开始标注点:"))

(setq l4 (getpoint l3 "\nndo...下一个标注点:"))

(setq b (- (car l1)  (car l2)))

(setq c (- (cadr l1) (cadr l2)))

(if (= b 0.0)

(progn

(command "dim" "_horizontal" (list (car l3) (cadr l1))  (list (car l4) (cadr l1))  l2  "" );command

(while

(setq l5 (getpoint l4 "\nndo...下一个标注点:"))

(command "_continue" (list (car l5) (cadr l1)) "" )

(setq l4 l5)

);while

(command "_horizontal"

(list (car l3) (cadr l1))

(list (car l4) (cadr l1))

(list (car l2)

(if (> (cadr l1) (cadr l2))

(- (cadr l2) (* (getvar "dimscale") 8))

(+ (cadr l2) (* (getvar "dimscale") 8))

);if

);list

""

"e"

);command

);progn

);if

(if (= c 0.0)

(progn

(command "dim"

"_vertical"

(list (car l1) (cadr l3))

(list (car l1) (cadr l4))

l2

""

);command

(while

(setq l5 (getpoint l4 "\nndo...下一个标注点:"))

(command "_continue"

(list (car l1) (cadr l5))

""

);command

(setq l4 l5)

);while

(command "_vertical"

(list (car l1) (cadr l3))

(list (car l1) (cadr l4))

(list (if (> (car l1) (car l2))

(- (car l2) (* (getvar "dimscale") 8))

(+ (car l2) (* (getvar "dimscale") 8))

);if

(cadr l2)

);list

""

"e"

);command

);progn

);if

(if (and (/= c 0.0) (/= b 0.0))

(progn

(setq d1 (- (car l1) (car l3)))

(setq d2 (- (car l1) (car l4)))

(setq e1 (- (cadr l1) (cadr l3)))

(setq e2 (- (cadr l1) (cadr l4)))

(setq x3 (/ (+ (* b b (car  l1)) (* c c (car  l3)) (* b c e1)) (+ (* b b) (* c c))))

(setq y3 (/ (+ (* b b (cadr l3)) (* c c (cadr l1)) (* b c d1)) (+ (* b b) (* c c))))

(setq x4 (/ (+ (* b b (car  l1)) (* c c (car  l4)) (* b c e2)) (+ (* b b) (* c c))))

(setq y4 (/ (+ (* b b (cadr l4)) (* c c (cadr l1)) (* b c d2)) (+ (* b b) (* c c))))

(command "dim"  "aligned"  (list x3 y3) (list x4 y4)  l2 "" );command

(while

(setq l5 (getpoint l4 "\nndo...下一个标注点:"))

(setq d2 (- (car l1) (car l5)))

(setq e2 (- (cadr l1) (cadr l5)))

(setq x5 (/ (+ (* b b (car  l1)) (* c c (car  l5)) (* b c e2)) (+ (* b b) (* c c))))

(setq y5 (/ (+ (* b b (cadr l5)) (* c c (cadr l1)) (* b c d2)) (+ (* b b) (* c c))))

(command "continue"                    (list x5 y5)

""

);command

(setq l4 l5)

);while

(setq alf (atan (/ (- (cadr l2) (cadr l1)) (- (car l2) (car l1)))))

(if (< (cadr l1) (cadr l2))

(setq x4 (+ (car l2) (* 8 (getvar "dimscale") (sin alf))))

(setq x4 (- (car l2) (* 8 (getvar "dimscale") (sin alf)))))

(if (< (cadr l1) (cadr l2))

(setq y4 (+ (cadr l2) (* 8 (getvar "dimscale") (cos alf))))

(setq y4 (- (cadr l2) (* 8 (getvar "dimscale") (cos alf)))))

(command "aligned"

(list x3 y3)

(list x5 y5)

(list x4 y4)

""

"e"

);command

);progn

);if

)

[/code]