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

jiajun_16888

有时由于各种原因将标注好的尺寸手动修改或打散了 

等以后修改图面时不知哪些修改过了   如果使用拉伸等命令尺寸不会跟着变，很容易出错

能不能写个检查程序  框一个范围就检查这里面有哪些尺寸是修改过的，然后高亮显示

谢谢

jiajun_16888

我这有一参考程序，但我只想知道哪些是改过的   谢谢

;切断尺寸关联，可在尺寸放缩后不改变尺寸数值，望需要着共同享用，cdim1为将关联尺寸取消，cdim2为将关联还原。
;将尺寸值改为固定数值
(DEFUN C:CHDIM1 ()
 (princ "\nselect object:")
 (setq s (ssget))
 (setq n (sslength s))
 (setq k 0 )
 (while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq b (assoc '0 a))
      (setq b (cdr b))
      (if (= b "DIMENSION")(progn
        (setq h1 (assoc '42 a))
        (setq h1 (cdr h1))
        (setq h1 (rtos h1 2 0))
        (setq h2 (assoc '1 a))
        (setq h1 (cons 1 H1))
        (setq a (subst h1 h2 a))
        (entmod a)
        ))
      (setq k (+ k 1))
 )
)

;将尺寸值改为可变数值
(DEFUN C:CHDIM2 ()
 (princ "\nselect object:")
 (setq s (ssget))
 (setq n (sslength s))
 (setq k 0 )
 (while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq b (assoc '0 a))
      (setq b (cdr b))
      (if (= b "DIMENSION")(progn
        (setq h2 (assoc '1 a))
        (setq h1 (cons 1 ""))
        (setq a (subst h1 h2 a))
        (entmod a)
        ))
      (setq k (+ k 1))
 )
)

jiajun_16888

参考程序
(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

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

yzr2002626

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

jiajun_16888

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

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

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

请版主再看看

ZZXXQQ

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

jiajun_16888

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

jiajun_16888

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

  谢谢