假尺寸工具求完善

苍天白鹤

在别处论坛看到一个假尺寸工具，如果图纸中有不是1：1标注的尺寸，则将尺寸放入新建的图层，并以红色显示，但在实际绘图中，会遇到标注样式中尺寸线及文字都规定了颜色，因此使假尺寸工具不能正常工作，请求高手完善程序。
程序如下：
(defun c:dcu()
  (command "layer" "m" "ed-dim" "c" "1" "" "")
  (setq ss1 (ssget "x" '((0 . "DIMENSION"))))
  (setq cl (sslength ss1))
  (setq sum 0)
  (while (< 0 cl)
    (setq sn (- cl 1))
    (setq fn (ssname ss1 sn))
    (setq textdate (entget fn))
    (setq nub  (cdr (assoc '42 textdate)))
    (setq dim  (cdr (assoc '1 textdate)))
    (if (and (/= dim "") (not (WCMATCH dim "*<>*")))
    (progn
     (command "change" fn "" "p" "la" "ed-dim" "c" "1" "")
     )
    )
    (setq cl (- cl 1))
   )
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "cmdecho" cmd)
(princ)
)

问题：
1、如果图纸的标注样式中的尺寸线、文字颜色设置为固定的颜色，你的假尺寸工具就无法起作用了。
2、如果图纸的颜色也设置成固定的颜色，你的假尺寸工具就无法起作用了。
建议：
1、程序中增加使标注样式中尺寸线、文字颜色改为随块或层
2、更改图纸的颜色为随层。

苍天白鹤

高手都隐居山林了?

苍天白鹤

我不信所有有人对图纸中的尺寸是否为1:1漠不关心，顶起来。
我试过了，更改dimclre、dimclrd、dimclrt这几个系统变量，会在标注样式下增加一个替代样式，以前标注的颜色不会改变。

yoyoho

;;修改一下给你参考

(defun c:dcu2()
  (command "layer" "m" "ed-dim" "c" "1" "" "")
  (setq ss1 (ssget "x" '((0 . "DIMENSION"))))
  (setq cl (sslength ss1))
  (setq sum 0)
  (while (< 0 cl)
    (setq sn (- cl 1))
    (setq fn (ssname ss1 sn))
    (setq textdate (entget fn))
    (setq nub  (cdr (assoc '42 textdate)))
    (setq dim  (cdr (assoc '1 textdate)))
       
    (setq VOBJ (vlax-ename->vla-object fn))
    (if (and VOBJ
             (vlax-read-enabled-p VOBJ)
             (not (wcmatch (vla-get-textoverride VOBJ) "*<>*,"))
             (vlax-write-enabled-p VOBJ)
        )
      (vla-put-textcolor VOBJ 1)   
      (vla-put-textcolor VOBJ 3)   
    )
   
    (setq cl (- cl 1))
   )
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "cmdecho" cmd)
(princ)
)

ljpnb

yoyoho 发表于 2011-6-24 11:40
;;修改一下给你参考

(defun c:dcu2()

程序还有些不足，我提些意见：
1。如果所标注的尺寸只是前缀加了%%C或4X，即为%%C<>或4X<>，这样尺寸应该为正常的。因为实际尺寸还是1:1的
2。如果尺寸比如是10，正常显示为"" 或<>，那如果修改成了10.0，这样尺寸应该也视为正常的。因为实际尺寸还是1:1的
3。有必要的话再增加提示，在程序结束之后，说明有几处尺寸有修改过。。。。
只是建议，并非我想要的程序。。。。。

苍天白鹤

多谢4楼，我去去研究一下。

自贡黄明儒

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;原来我搞了一个，不简洁。这个很简洁
(defun C:DimensionTorF (/ ss)
  (setq ss (ssget "X"
    '((0 . "DIMENSION")
      (-4 . "<AND")
      (-4 . "<NOT")
      (1 . "")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (1 . "*<>*")
      (-4 . "NOT>")
      (-4 . "AND>")
     )
    )   
  )   
  (SS_hilite ss 3)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

苍天白鹤

定楼上，但是穷阿，买不起。

zsw23

能不能检测出来之后，自动修复呢？