jiajun_16888 发表于 2010-5-2 00:34:00

[求助] 哪们大大帮忙写个尺寸检查程序

<p>有时由于各种原因将标注好的尺寸手动修改或打散了&nbsp; </p><p>等以后修改图面时不知哪些修改过了&nbsp;&nbsp; 如果使用拉伸等命令尺寸不会跟着变，很容易出错</p><p>能不能写个检查程序&nbsp; 框一个范围就检查这里面有哪些尺寸是修改过的，然后高亮显示</p><p>谢谢</p>

jiajun_16888 发表于 2010-5-3 11:14:00

<p></p><p>我这有一参考程序，但我只想知道哪些是改过的&nbsp;&nbsp; 谢谢</p><p></p><p>;切断尺寸关联，可在尺寸放缩后不改变尺寸数值，望需要着共同享用，cdim1为将关联尺寸取消，cdim2为将关联还原。<br/>;将尺寸值改为固定数值<br/>(DEFUN C:CHDIM1 ()<br/>&nbsp;(princ "\nselect object:")<br/>&nbsp;(setq s (ssget))<br/>&nbsp;(setq n (sslength s))<br/>&nbsp;(setq k 0 )<br/>&nbsp;(while (&lt; k n) <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq name (ssname s k))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq a (entget name))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq b (assoc '0 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq b (cdr b))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (= b "DIMENSION")(progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h1 (assoc '42 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h1 (cdr h1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h1 (rtos h1 2 0))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h2 (assoc '1 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h1 (cons 1 H1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq a (subst h1 h2 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmod a)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq k (+ k 1))<br/>&nbsp;)<br/>)</p><p><br/>;将尺寸值改为可变数值<br/>(DEFUN C:CHDIM2 ()<br/>&nbsp;(princ "\nselect object:")<br/>&nbsp;(setq s (ssget))<br/>&nbsp;(setq n (sslength s))<br/>&nbsp;(setq k 0 )<br/>&nbsp;(while (&lt; k n) <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq name (ssname s k))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq a (entget name))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq b (assoc '0 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq b (cdr b))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (= b "DIMENSION")(progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h2 (assoc '1 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq h1 (cons 1 ""))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq a (subst h1 h2 a))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmod a)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq k (+ k 1))<br/>&nbsp;)<br/>)<br/></p>

jiajun_16888 发表于 2010-5-3 11:37:00

参考程序
(defun scale_db        (/ lfac ans ceco)        ;判斷尺寸標注所用數值是否為實測距離,並做出相應處理.sssssssssssssssssssssssssss
(setvar "cmdecho" 0)
(setq        lfac (getvar "dimlfac")
        ceco (getvar "cecolor")
        ans""
)                                        ;end setq
(if (/= lfac 1)
    (progn
      (while (AND (/= ans "N") (/= ans "Y"))
        (setq
          ans (strcase (getstring (strcat "\n此時標注之尺寸為實距的"
                                          (rtos lfac)
                                          "倍,是否繼續標注?(Y/N)"
                                  ) ;_ end of strcat
                     ) ;_ end of getstring
              ) ;_ end of strcase
        )                                ;end setq
        (if (= ans "N")
          (progn
          (setvar "dimlfac" 1)
;;;          (command "color" "bylayer")
          )                                ;end progn then
        )                                ;end if(= ans "N")
;;;        (if (= ans "Y")
;;;              (command "color" "cyan")
;;;        )                                ;end if (= ans "Y")

      )                                        ;END while

    )                                        ;end progn then
                                        ;else
;;;    (progn
;;;          (command "color" "bylayer")
;;;    )                                        ;end progn else
)                                        ;end if (/= lfac 1.0)
)                                        ;end defun scale

ZZXXQQ 发表于 2010-5-3 20:27:00

;;如尺寸值與文本一致，則文本不變色，否則文本被修改但顏色<br/>;;變如紅色，這樣用戶對這個功能會更好理解也容易維護。 <br/>;;BY LUCAS 2004.9<br/>(defun C:TT (/ SS N VOBJ)<br/>&nbsp; (setq SS (ssget "X" '((0 . "DIMENSION")))<br/>&nbsp;N&nbsp; 0<br/>&nbsp; )<br/>&nbsp; (repeat (sslength SS)<br/>&nbsp;&nbsp;&nbsp; (setq VOBJ (vlax-ename-&gt;vla-object (ssname SS N)))<br/>&nbsp;&nbsp;&nbsp; (if (and VOBJ<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vlax-read-enabled-p VOBJ)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (not (wcmatch (vla-get-textoverride VOBJ) "*&lt;&gt;*,"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vlax-write-enabled-p VOBJ)<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vla-put-textcolor VOBJ 1)<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; (setq N (1+ N))<br/>&nbsp; )<br/>&nbsp; (princ)<br/>)

yzr2002626 发表于 2010-5-3 21:14:00

版主最后那程序最好是可以选择范围检查

jiajun_16888 发表于 2010-5-3 21:15:00

版主 我把ssget "X" \'((0 . "DIMENSION"里的\去掉 结果运行到(ssname SS N)这地方又出问题了

tt ; 错误: no function definition: VLAX-ENAME-&gt;VLA-OBJECT

是不我这CAD和你们有什么不同啊都要把\去掉   

请版主再看看

ZZXXQQ 发表于 2010-5-4 22:23:00

1、不知道为什么会有\？我这里都没有。<br/>2、函数找不到，程序前头加上一行(vl-load-com)试试。

jiajun_16888 发表于 2010-5-4 23:39:00

OK   问题解决   我自己试了好久就是搞不定

真厉害谢谢

jiajun_16888 发表于 2010-5-4 23:50:00

版主这个程序非常好用       能不能再编个检查尺寸标注放大倍数的 就是有些尺寸标注时已经改了比例因子的用另一种颜色表示

谢谢
页: [1]
查看完整版本: [求助] 哪们大大帮忙写个尺寸检查程序