明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 15375|回复: 27

[原创]锁定dim标注数值(支持公差等格式)

  [复制链接]
发表于 2004-3-11 21:28 | 显示全部楼层 |阅读模式
  1. ;; dmvl ==锁定dim标注数值==明经通道==2004.3.11.
  2. ;;
  3. (defun c:dmvl (/ ss i ent e e1 intpnt blkname blk obj txt)
  4.    (vl-load-com)
  5.    (setq  ss (ssget '((0 . "DIMENSION")))
  6.   i   0
  7.    )
  8.    (repeat (sslength ss)
  9.        (setq ent     (ssname ss i)
  10.      e     (entget ent)
  11.      e1     (cdr (assoc 1 e))
  12.      intpnt   (cdr (assoc 11 e))
  13.      blkname (cdr (assoc 2 e))
  14.      blk     (vla-item (vla-get-blocks
  15.                  (vla-get-Activedocument (vlax-get-acad-object))
  16.              )
  17.              blkname
  18.        )
  19.        )
  20.        (vlax-for obj blk
  21.            (if (= (vla-get-objectname obj) "AcDbMText")
  22.   (progn
  23.      (setq  txt (vla-get-textstring obj)
  24.      )
  25.      (if (or (= "" e1) (wcmatch e1 "*<>*"))
  26.          (progn
  27.              (setq e (subst (cons 1 txt) (assoc 1 e) e))
  28.              (entmod e)
  29.              (entupd ent)
  30.          )
  31.      )
  32.   )
  33.            )
  34.        )       (setq i (1+ i))
  35.    )
  36.    (princ)
  37. )
发表于 2018-12-7 15:00 | 显示全部楼层
谢谢分享,学习了...
发表于 2004-3-15 16:19 | 显示全部楼层
双枪手,真厉害!请问VBA程式How to use? 请别见笑,lisp我懂还会编,但VBA到目前为止如同一个娃娃学步的级别。请老师指点三本高级中级低级VBA书籍,在下有礼了,谢谢! 看样子,这个程序主要功能是把dim标注数值用文字形式固定下来,这样在放大缩小图纸时不必担心尺寸值走样。我以前也编过类似的程序,不过还不够完善。还应有一个逆程序,可以在想要回复时也有办法。
 楼主| 发表于 2004-3-15 21:21 | 显示全部楼层
改回去因为太简单了,所以没有写,你自己试试吧。


VBA的书本来就少,好书就更少了。我们想写,但时间太少,呵呵,手头的书也只写了一点点。


帮助文件是很好的教材,试试吧,论坛也有介绍一些VBA的书,你查查看。
发表于 2004-3-19 17:07 | 显示全部楼层
我做过测试了,在CAD2000以上是可以用的,但因为有好多vla-*类语句,在R14下是没办法运行的。但总来讲,程序还是很实用的。
发表于 2004-3-19 20:22 | 显示全部楼层
给你个恢复的选择尺寸敲两次空格键就恢复了,当然也可以编辑尺寸文本 ;=================
;修改尺寸文本
;LJC 2004.2
;====================
(DEFUN C:eDD(/ ss n a d i)
(princ "\n选择修改的尺寸")
(princ)
(SETQ SS(SSGET '((0 . "dimension")) ))
(setq n(sslength ss) i 0)
(setq a(getstring "文本修改为:"))
(repeat n
(setq d(entget (ssname ss i)))
(setq d (subst (cons 1 a) (assoc 1 d) d))
(entmod d)
(entupd (ssname ss i))
(setq i (1+ i))
)
)
发表于 2004-3-19 23:41 | 显示全部楼层
为什么不用:


  1. (defun c:dmn (/ str)


  2.          (vl-cmdf ".dim" "n" (if (setq str (getstring "\n新标注文本&lt;回车=默认值&gt;:")) str "&lt;&gt;")         (ssget) "" "e")

  3. )

发表于 2004-3-19 23:46 | 显示全部楼层
重发支持r14的标注固定硬改法
  1. ;;(getdimtext dimentity) = 取出标注的文本!;;支持所有标注类型.
  2. (defun c:dmvl (/ ss n dm dml)
  3.    (princ "\ndmvl = 块定义修改法-固定标注文字!   ------by 无痕.2004.3
  4. \n选择要固定文字的标注:")
  5.    (setq ss (ssget '((0 . "DIMENSION"))))
  6.    (repeat (setq n (sslength ss))
  7.        (setq dm (ssname ss (setq n (1- n)))
  8.      dml(entget dm)
  9.      dml(subst (cons 1 (getdimtext dm))(assoc 1 dml) dml))
  10.        (entmod dml)
  11.    )(princ (strcat "\n共处理" (itoa (sslength ss)) "个标注:"))
  12.    (princ)
  13. )
  14. ;;取标注文本.  
  15. (defun getdimtext (ent / dimblk roop e el)
  16.    (setq dimblk (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget ent))))))
  17.   roop T)
  18.    (while roop
  19.        (setq e (entnext e)
  20.      el(entget e))
  21.        (if (member '(0 . "MTEXT") el)
  22.            (setq roop nil)
  23.        )
  24.    )
  25.    (cdr (assoc 1 el))
  26. )
发表于 2004-3-20 14:26 | 显示全部楼层
谢谢拉!!!过几天上传一个Rotate and copy 程序,特别适用变角度拷贝。现在正在调试。
 楼主| 发表于 2004-3-20 18:11 | 显示全部楼层
wyj_007发表于2004-3-20 14:26:00谢谢拉!!!过几天上传一个Rotate and copy 程序,特别适用变角度拷贝。现在正在调试。
这个其实很简单:
  1. ;;复制旋转对象
  2. (defun c:cr ()
  3.    (setq ent (ssget))
  4.    (command "copy" ent "" pause "@" "rotate" "p" "" "@")
  5. )
发表于 2004-3-20 21:10 | 显示全部楼层
无痕发表于2004-3-19 23:41:00为什么不用: (defun c:dmn (/ str) (vl-cmdf \".dim\" \"n\" (if (setq str (getstring \"\n新标注文本<回车=默认值>:\")) str \"<&g...

不好意思,我初学LSP其实对VL是一点都不懂,只是前一段时间刚好需要要这样的东西自己就写了一下翻到这一贴觉得还能用的上就.....,不过还是谢谢您的指点,我会努力的...
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 10:33 , Processed in 0.303498 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表