[源码]动态的公差基准

cabinsummer

1. (defun c:DTM(/ os olderr scl obj ename edata ename0 edata0 ename1 edata1 ename2 edata2)
   
2.   (vl-load-com)
   
3.   
   
4.   (defun dtmerr(msg)
   
5.     (command "undo" "e")
   
6.     (setvar "osmode" os)
   
7.     (if ename0 (entdel ename0))
   
8.     (if ename1 (entdel ename1))
   
9.     (if ename2 (entdel ename2))
   
10.     (setq *error* olderr)
    
11.   )
    
12.   (defun createdatum(/ blk)
    
13.     (setq ename0 nil)
    
14.     (setq ename1 nil)
    
15.     (setq ename2 nil)
    
16.     (if (setq obj (nentsel))
    
17.       (progn
    
18.         (setq spnt (cadr obj))
    
19.         (setq obj (vlax-ename->vla-object (car obj)))
    
20.         (entmake (list '(0 . "BLOCK")(cons 2 "*U")'(70 . 1)'(10 0.0 0.0 0.0)))
    
21.         (entmake (list '(0 . "TEXT")'(10 0.0 0.0 0.0)'(11 0.0 0.0 0.0)'(8 . "DIM")'(40 . 3.5)'(62 . 3)'(72 . 4)'(1 . "")))
    
22.         (entmake (list '(0 . "CIRCLE")'(8 . "DIM")'(10 0.0 0.0 0.0)'(40 . 3.5)))
    
23.         (setq blk (entmake '((0 . "ENDBLK"))))
    
24.         (entmake (list '(0 . "INSERT")'(10 0.0 0.0 0.0)(cons 41 scl)(cons 42 scl)(cons 2 blk)))
    
25.         (setq ename0 (entlast))
    
26.         (setq edata0 (entget ename0))
    
27.         (setq ename (entnext (tblobjname "BLOCK" blk)))
    
28.         (setq edata (entget ename))
    
29.         (entmake (list '(0 . "LINE")'(8 . "DIM")'(10 0.0 1.6 0.0)'(11 0.0 6.5 0.0)))
    
30.         (setq ename1 (entlast))
    
31.         (setq edata1 (entget ename1))
    
32.         (entmake (list '(0 . "LWPOLYLINE")'(8 . "DIM")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 2)'(43 . 0.4)'(10 3.5 1.6 0.0)'(10 -3.5 1.6 0.0)))
    
33.         (setq ename2 (entlast))
    
34.         (setq edata2 (entget ename2))
    
35.       )
    
36.     )
    
37.   )
    
38.   
    
39.   (defun do_move(/ mpos npnt ang spnt epnt pnt0 pnt1)
    
40.     (setq mpos (cadr code))
    
41.     (setq npnt (vlax-curve-getClosestPointTo obj mpos T))
    
42.    
    
43.     (setq ang (angle npnt mpos))
    
44.     (if (< (distance mpos npnt) (* scl 10.0)) (setq mpos (polar npnt (angle npnt mpos) (* scl 10.0))))
    
45.     (setq edata0 (subst (cons 10 mpos) (assoc 10 edata0) edata0))
    
46.     (setq spnt (polar npnt ang (* scl 1.6)))
    
47.     (setq epnt (polar npnt ang (- (distance mpos npnt)(* scl 3.5))))
    
48.     (setq edata1 (subst (cons 10 spnt) (assoc 10 edata1) edata1))
    
49.     (setq edata1 (subst (cons 11 epnt) (assoc 11 edata1) edata1))
    
50.     (setq pnt0 (polar spnt (+ ang (/ pi 2.0)) (* scl 3.5)))
    
51.     (setq pnt1 (polar spnt (- ang (/ pi 2.0)) (* scl 3.5)))
    
52.     (setq edata2 (subst (cons 10 pnt0) (assoc 10 edata2) edata2))
    
53.     (setq edata2 (subst (cons 10 pnt1) (nth 4 (member (assoc 10 edata2) edata2)) edata2))
    
54.     (entmod edata0)
    
55.     (entmod edata1)
    
56.     (entmod edata2)
    
57.     (entupd ename0)
    
58.     (entupd ename1)
    
59.     (entupd ename2)
    
60.   )
    
61.   (defun do_datum (/ ref string)
    
62.     (setq ref (cadr code))
    
63.     (if (or (<= 65 ref 90) (<= 97 ref 122))
    
64.       (progn
    
65.         (setq string (strcase (chr ref)))
    
66.         (setq edata (subst (cons 1 string)(assoc 1 edata) edata))
    
67.         (entmod edata)
    
68.         (entupd ename)
    
69.       )
    
70.     )
    
71.   )
    
72.   (setvar "cmdecho" 0)
    
73.   (setq os (getvar "osmode"))
    
74.   (setvar "osmode" 0)
    
75.   (command "undo" "be")
    
76.   (setq olderr *error*)
    
77.   (setq *error* dtmerr)
    
78.   (setq scl (getvar "dimscale"))
    
79.   
    
80.   (prompt "Please select object:\n")
    
81.   (createdatum)
    
82.   (setq loop T)
    
83.   (while (and obj loop)
    
84.     (setq code (grread T 8))
    
85.     (cond
    
86.       ((= (car code) 5)(do_move))                                ;;;move
    
87.       ((= (car code) 3)(createdatum))                            ;;;left-right
    
88.       ((or (= (car code) 11)(= (car code) 25))(setq loop nil))   ;;;button-right
    
89.       ((= (car code) 2)(do_datum))                               ;;;datum
    
90.     )
    
91.   )
    
92.   
    
93.   (command "undo" "e")
    
94.   (setvar "osmode" os)
    
95.   (setq *error* olderr)
    
96.   (princ)
    
97. )

(defun c:DTM(/ os olderr scl obj ename edata ename0 edata0 ename1 edata1 ename2 edata2)<br />   (vl-load-com)<br />   <br />   (defun dtmerr(msg)<br />     (command "undo" "e")<br />     (setvar "osmode" os)<br />     (if ename0 (entdel ename0))<br />     (if ename1 (entdel ename1))<br />     (if ename2 (entdel ename2))<br />     (setq *error* olderr)<br />   )<br />   (defun createdatum(/ blk)<br />     (setq ename0 nil)<br />     (setq ename1 nil)<br />     (setq ename2 nil)<br />     (if (setq obj (nentsel))<br />       (progn<br />         (setq spnt (cadr obj))<br />         (setq obj (vlax-ename->vla-object (car obj)))<br />         (entmake (list '(0 . "BLOCK")(cons 2 "*U")'(70 . 1)'(10 0.0 0.0 0.0)))<br />         (entmake (list '(0 . "TEXT")'(10 0.0 0.0 0.0)'(11 0.0 0.0 0.0)'(8 . "DIM")'(40 . 3.5)'(62 . 3)'(72 . 4)'(1 . "")))<br />         (entmake (list '(0 . "CIRCLE")'(8 . "DIM")'(10 0.0 0.0 0.0)'(40 . 3.5)))<br />         (setq blk (entmake '((0 . "ENDBLK"))))<br />         (entmake (list '(0 . "INSERT")'(10 0.0 0.0 0.0)(cons 41 scl)(cons 42 scl)(cons 2 blk)))<br />         (setq ename0 (entlast))<br />         (setq edata0 (entget ename0))<br />         (setq ename (entnext (tblobjname "BLOCK" blk)))<br />         (setq edata (entget ename))<br />         (entmake (list '(0 . "LINE")'(8 . "DIM")'(10 0.0 1.6 0.0)'(11 0.0 6.5 0.0)))<br />         (setq ename1 (entlast))<br />         (setq edata1 (entget ename1))<br />         (entmake (list '(0 . "LWPOLYLINE")'(8 . "DIM")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 2)'(43 . 0.4)'(10 3.5 1.6 0.0)'(10 -3.5 1.6 0.0)))<br />         (setq ename2 (entlast))<br />         (setq edata2 (entget ename2))<br />       )<br />     )<br />   )<br />   <br />   (defun do_move(/ mpos npnt ang spnt epnt pnt0 pnt1)<br />     (setq mpos (cadr code))<br />     (setq npnt (vlax-curve-getClosestPointTo obj mpos T))<br />     <br />     (setq ang (angle npnt mpos))<br />     (if (< (distance mpos npnt) (* scl 10.0)) (setq mpos (polar npnt (angle npnt mpos) (* scl 10.0))))<br />     (setq edata0 (subst (cons 10 mpos) (assoc 10 edata0) edata0))<br />     (setq spnt (polar npnt ang (* scl 1.6)))<br />     (setq epnt (polar npnt ang (- (distance mpos npnt)(* scl 3.5))))<br />     (setq edata1 (subst (cons 10 spnt) (assoc 10 edata1) edata1))<br />     (setq edata1 (subst (cons 11 epnt) (assoc 11 edata1) edata1))<br />     (setq pnt0 (polar spnt (+ ang (/ pi 2.0)) (* scl 3.5)))<br />     (setq pnt1 (polar spnt (- ang (/ pi 2.0)) (* scl 3.5)))<br />     (setq edata2 (subst (cons 10 pnt0) (assoc 10 edata2) edata2))<br />     (setq edata2 (subst (cons 10 pnt1) (nth 4 (member (assoc 10 edata2) edata2)) edata2))<br />     (entmod edata0)<br />     (entmod edata1)<br />     (entmod edata2)<br />     (entupd ename0)<br />     (entupd ename1)<br />     (entupd ename2)<br />   )<br />   (defun do_datum (/ ref string)<br />     (setq ref (cadr code))<br />     (if (or (<= 65 ref 90) (<= 97 ref 122))<br />       (progn<br />         (setq string (strcase (chr ref)))<br />         (setq edata (subst (cons 1 string)(assoc 1 edata) edata))<br />         (entmod edata)<br />         (entupd ename)<br />       )<br />     )<br />   )<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (command "undo" "be")<br />   (setq olderr *error*)<br />   (setq *error* dtmerr)<br />   (setq scl (getvar "dimscale"))<br />   <br />   (prompt "Please select object:\n")<br />   (createdatum)<br />   (setq loop T)<br />   (while (and obj loop)<br />     (setq code (grread T 8))<br />     (cond<br />       ((= (car code) 5)(do_move))                                ;;;move<br />       ((= (car code) 3)(createdatum))                            ;;;left-right<br />       ((or (= (car code) 11)(= (car code) 25))(setq loop nil))   ;;;button-right<br />       ((= (car code) 2)(do_datum))                               ;;;datum<br />     )<br />   )<br />   <br />   (command "undo" "e")<br />   (setvar "osmode" os)<br />   (setq *error* olderr)<br />   (princ)<br /> )

操作方法：左键选择需要标注公差基准的图元，拖动到合适的位置后左键确定，可连续标注，字母键改变基准标识，右键退出
暂时对块中图元不支持，这个问题在我前几天的帖子http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91567&page=1#pid501705中继续讨论

ninja37

风大师你这个程序很好用  对于我们这个行业来说  一个程序拆解一下就好了。分成两个程序
第1个程序  只需要粗一点的那根线  其他全部不要，也不要按一下出现字母的功能 ，程序还是要动态的确定那根线的位置 我们厂里用来标识零件内凹 还是凸起来
第2个程序  只需要垂直的那根线  其他全部不要 ，也不要按一下出现字母的功能 ，程序还是要动态的确定那根线的位置 ，这根线我们厂里用来做零件的引入线
风大师，由于顾虑你没有时间来修改一下，还在编程求助里开了一个求助，如果你有空修改一下是最好了。

yangwunhong

冒个烟圈 发表于 2015-5-20 14:36
我跟你出现的问题一样，应该是这句引起的(entmake (list '(0 . "LWPOLYLINE")'(8 . "DIM")'(100 . "AcDbE ...

解决很简单，将最后一个点对列表'(10 -3.5 1.6 0.0)删除即可。

ninja37

命令: ; 错误: 参数类型错误: numberp: nil     不知道什么原因

cabinsummer

这个功能本来可以用grread中的osnap实现，但是我已经用它发了两个动态了，再继续下去就要泛滥成灾，所以用选取图元求最近距离的方法实现。因为对图块的操作出问题，所以发帖讨论块中图元原位复制。目前这个问题还没有完全解决，最佳结果是高飞鸟的程序。

669423907

风的杰作，一定要收藏！再来一个倒角标注，那就爽歪歪了！

hpy

这个程序如何使用呀？使用时怎么不出现那个基准符号呀？

cabinsummer

hpy 发表于 2012-1-4 08:20
这个程序如何使用呀？使用时怎么不出现那个基准符号呀？

命令为DTM，要按字母键才出现基准字母

hanxing0335

太好了~~~~

qjcpj

cabinsummer 发表于 2012-1-4 12:04
命令为DTM，要按字母键才出现基准字母

提个建议：
1.能否在输入A后，以后如不按键则默认B -> C -> D ......
2.能否在运行命令时提供输入基准字母A、B、C ...... 的输入候选框供选择，以后按字母键则按用户输入，不按的话则按建议第一条处理。
3.系统变量dimscale为0时程序运行有问题，提示为“选择对象: 块参照比例 (0.0000) 无效，设为默认值 1.0000。”，必须设置为非0才正常，请楼主检查。
    最后感谢风大侠提供的精彩源码！

jfxia

  顶一下好用的源码

wowan1314

这个经典,太值得借鉴了! 学习动态的范例。收藏之

风雨依然

好东西 收藏了顶起