cabinsummer 发表于 2012-1-3 10:31:59

[源码]动态的公差基准

本帖最后由 cabinsummer 于 2016-12-24 15:07 编辑


(defun c:DTM(/ os olderr scl obj ename edata ename0 edata0 ename1 edata1 ename2 edata2)
(vl-load-com)

(defun dtmerr(msg)
    (command "undo" "e")
    (setvar "osmode" os)
    (if ename0 (entdel ename0))
    (if ename1 (entdel ename1))
    (if ename2 (entdel ename2))
    (setq *error* olderr)
)
(defun createdatum(/ blk)
    (setq ename0 nil)
    (setq ename1 nil)
    (setq ename2 nil)
    (if (setq obj (nentsel))
      (progn
      (setq spnt (cadr obj))
      (setq obj (vlax-ename->vla-object (car obj)))
      (entmake (list '(0 . "BLOCK")(cons 2 "*U")'(70 . 1)'(10 0.0 0.0 0.0)))
      (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 . "")))
      (entmake (list '(0 . "CIRCLE")'(8 . "DIM")'(10 0.0 0.0 0.0)'(40 . 3.5)))
      (setq blk (entmake '((0 . "ENDBLK"))))
      (entmake (list '(0 . "INSERT")'(10 0.0 0.0 0.0)(cons 41 scl)(cons 42 scl)(cons 2 blk)))
      (setq ename0 (entlast))
      (setq edata0 (entget ename0))
      (setq ename (entnext (tblobjname "BLOCK" blk)))
      (setq edata (entget ename))
      (entmake (list '(0 . "LINE")'(8 . "DIM")'(10 0.0 1.6 0.0)'(11 0.0 6.5 0.0)))
      (setq ename1 (entlast))
      (setq edata1 (entget ename1))
      (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)))
      (setq ename2 (entlast))
      (setq edata2 (entget ename2))
      )
    )
)

(defun do_move(/ mpos npnt ang spnt epnt pnt0 pnt1)
    (setq mpos (cadr code))
    (setq npnt (vlax-curve-getClosestPointTo obj mpos T))
   
    (setq ang (angle npnt mpos))
    (if (< (distance mpos npnt) (* scl 10.0)) (setq mpos (polar npnt (angle npnt mpos) (* scl 10.0))))
    (setq edata0 (subst (cons 10 mpos) (assoc 10 edata0) edata0))
    (setq spnt (polar npnt ang (* scl 1.6)))
    (setq epnt (polar npnt ang (- (distance mpos npnt)(* scl 3.5))))
    (setq edata1 (subst (cons 10 spnt) (assoc 10 edata1) edata1))
    (setq edata1 (subst (cons 11 epnt) (assoc 11 edata1) edata1))
    (setq pnt0 (polar spnt (+ ang (/ pi 2.0)) (* scl 3.5)))
    (setq pnt1 (polar spnt (- ang (/ pi 2.0)) (* scl 3.5)))
    (setq edata2 (subst (cons 10 pnt0) (assoc 10 edata2) edata2))
    (setq edata2 (subst (cons 10 pnt1) (nth 4 (member (assoc 10 edata2) edata2)) edata2))
    (entmod edata0)
    (entmod edata1)
    (entmod edata2)
    (entupd ename0)
    (entupd ename1)
    (entupd ename2)
)
(defun do_datum (/ ref string)
    (setq ref (cadr code))
    (if (or (<= 65 ref 90) (<= 97 ref 122))
      (progn
      (setq string (strcase (chr ref)))
      (setq edata (subst (cons 1 string)(assoc 1 edata) edata))
      (entmod edata)
      (entupd ename)
      )
    )
)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq olderr *error*)
(setq *error* dtmerr)
(setq scl (getvar "dimscale"))

(prompt "Please select object:\n")
(createdatum)
(setq loop T)
(while (and obj loop)
    (setq code (grread T 8))
    (cond
      ((= (car code) 5)(do_move))                              ;;;move
      ((= (car code) 3)(createdatum))                            ;;;left-right
      ((or (= (car code) 11)(= (car code) 25))(setq loop nil))   ;;;button-right
      ((= (car code) 2)(do_datum))                               ;;;datum
    )
)

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

ninja37 发表于 2022-6-5 06:50:12

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

yangwunhong 发表于 2018-4-22 21:52:34

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

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

ninja37 发表于 2022-6-1 21:38:17

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

cabinsummer 发表于 2012-1-3 10:34:56

本帖最后由 cabinsummer 于 2012-1-7 09:20 编辑

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

669423907 发表于 2012-1-3 12:48:59

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

hpy 发表于 2012-1-4 08:20:57

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

cabinsummer 发表于 2012-1-4 12:04:12

本帖最后由 cabinsummer 于 2012-1-4 12:06 编辑

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

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

hanxing0335 发表于 2012-1-4 12:38:11

太好了~~~~

qjcpj 发表于 2012-1-4 16:33:16

本帖最后由 qjcpj 于 2012-1-5 10:02 编辑

cabinsummer 发表于 2012-1-4 12:04 http://bbs.mjtd.com/static/image/common/back.gif
命令为DTM，要按字母键才出现基准字母

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

jfxia 发表于 2012-1-5 19:36:04

顶一下好用的源码

wowan1314 发表于 2012-5-3 18:26:38

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

风雨依然 发表于 2013-5-18 20:18:38

好东西 收藏了顶起
页: [1] 2 3
查看完整版本: [源码]动态的公差基准