【源码分享】无聊了模仿天正逐点标注
本帖最后由 wowan1314 于 2013-6-12 20:16 编辑如题；尝试模仿天正逐点标注。
程序基本实现连续标注的目的
缺点：1、标注中无法UNDO 2、点到已经标注的中间时候不能更新（修正为可更新最后一个标注）。
3、尺寸不能实时自动避让。(这个论坛有程序标完后处理下即可)
9楼更新了增补尺寸配套程序。配套程序可单独使用也可编辑进双击反应器
关于后面两点我在“工具插件”板块已经发布解决后的程序。 第一点的话测试用INITGET来达到UNDO。不过UNDO会记录平移与缩放，导致程序无法准确运行。
不知道天正是怎么解决第一点的。也许思路不同？！有兴趣的可以尝试完善.
;;加尺寸避让可以这样写。尺寸避让没研究过，我也不引用了。我提供个思路，有兴趣的自己调整
(defun T6 ( / ENT ss)
(SETQ ENT (ENTLAST))
(C:T1);逐点标注主程序
(SETQ SS (LAST-ENT ENT));;取得刚才标注的选择集 last-ent为自定义函数论坛有
(CCBR SS);;CCBR为尺寸避让的程序
)
最终版“逐点标注”源码地址：http://bbs.mjtd.com/forum.php?mo ... 1084&fromuid=282351
最终版“增补尺寸”源码地址：http://bbs.mjtd.com/forum.php?mo ... 0786&fromuid=282351
试用了下YAD的程序。
他的逐点标注程序第一点：也没满足。 第二点：能回头标一次。第三点：双击可以增补。 clh521 发表于 2013-3-29 15:01
正好我昨天也编了一个连续标注（水平不高，用Command实现的）
这个没有实现标注引线对齐。 特定用户下载 微笑脸 有什么意思？ 这个可以偶 期待已久的插件，希望高手们修改后晚上后公布出来， ;;;连续尺寸对齐标注
(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 "\n<U>ndo...下一个标注点:"))
(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 "\n<U>ndo...下一个标注点:"))
(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 "\n<U>ndo...下一个标注点:"))
(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 (carl1)) (* c c (carl3)) (* 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 (carl1)) (* c c (carl4)) (* 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 "\n<U>ndo...下一个标注点:"))
(setq d2 (- (car l1) (car l5)))
(setq e2 (- (cadr l1) (cadr l5)))
(setq x5 (/ (+ (* b b (carl1)) (* c c (carl5)) (* 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
)
xshrimp 发表于 2013-3-29 12:17 static/image/common/back.gif
dear sir,
great work
探索者自带，不知道优势在哪儿 本帖最后由 clh521 于 2013-3-29 15:04 编辑
正好我昨天也编了一个连续标注（水平不高，用Command实现的）
本帖最后由 wowan1314 于 2013-6-8 11:12 编辑
没想到此程序反应还不错。
所以也进一步做了增补尺寸的配套程序,同样此程序也存在前两个缺点.
此配套程序可与双击反应器配合使用以便达到双击修改的效果 在尺寸中间增补尺寸有时候不好使，不明白为什么？！
增补能在原尺寸 中插入 增补尺寸吗？