langjs 发表于 2012-3-13 12:59:44

;;; ======================================
;;; 名称: 尺寸检查
;;; 功能：尺寸起末点不在线端点数值显示红色
;;; ======================================
(defun c:aa (/ ent i lst name p p13 p14 ss ss0)
(setvar "cmdecho" 0)
(vl-load-com)
(setq lst '()        p t)
(if (setq ss0 (ssget "X" '((0 . "DIMENSION"))))
    (repeat (setq i (sslength ss0))
      (setq name (ssname ss0 (setq i (1- i))))
      (if (= (vla-get-textcolor (vlax-ename->vla-object name)) 1)
        (setq ss (vlax-put-property (vlax-ename->vla-object name) "textcolor" 256)p nil)
      ) )
)
(if p
    (progn (if (setq ss (ssget "X" '((0 . "ARC,CIRCLE"))))
        (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i)))) lst (cons (cdr (assoc 10 ent)) lst)          )
          (if (assoc 50 ent) (setq lst (cons (polar (cdr (assoc 10 ent)) (cdr (assoc 50 ent)) (cdr (assoc 40 ent))) lst)))
          (if (assoc 51 ent) (setq lst (cons (polar (cdr (assoc 10 ent)) (cdr (assoc 51 ent)) (cdr (assoc 40 ent))) lst)))
        ))
      (if (setq ss (ssget "X" '((0 . "DIMENSION"))))
        (repeat (setq i (sslength ss))
          (setq name (ssname ss (setq i (1- i))) p13 (cdr (assoc 13 (entget name))) p14 (cdr (assoc 14 (entget name))))
          (if (and(or (member p13 lst) (ssget "c" p13 p13 '((0 . "LWPOLYLINE,LINE,PLINE"))))
                  (or (member p14 lst) (ssget "c" p14 p14 '((0 . "LWPOLYLINE,LINE,PLINE"))))
              )
          (princ)
          (vlax-put-property (vlax-ename->vla-object name) "textcolor" 1)
          ))))
)
(princ)
)

无欲神 发表于 2012-3-13 18:50:47

看看是不是非常好啊

461045462 发表于 2012-3-16 19:50:49

本帖最后由 461045462 于 2012-4-23 09:04 编辑

谢谢11楼的分享
收藏了，学习学习
谢谢

adc 发表于 2014-4-30 12:09:25

langjs 发表于 2012-3-11 11:45 static/image/common/back.gif
一个类似作用的
;;; ======================================
;;; 名称: 尺寸检查


如果不在端点上，能不能自动移动到端点上

chenqiang26 发表于 2019-4-2 06:17:30

:funk:刚去试了下，如果标注半径直径也会变成红色。。。。还有能不能增加有多少个标注变成了红色，这样好找一点

chenqiang26 发表于 2019-4-2 06:18:48

langjs 发表于 2012-3-13 12:59
;;; ======================================
;;; 名称: 尺寸检查
;;; 功能：尺寸起末点不在线端点数值显 ...

刚去试了下，如果标注半径直径也会变成红色。。。。还有能不能增加有多少个标注变成了红色，这样好找一点

cghdy 发表于 2019-11-26 09:51:13

精度控制的太细吗，运行一下全显红

00放飞梦想00 发表于 2021-12-7 19:27:10

楼主能把这个代码发我一下吗？

a1553289838 发表于 2024-7-26 22:36:29

langjs 发表于 2012-3-11 11:45
一个类似作用的
;;; ======================================
;;; 名称: 尺寸检查


太牛了，大神
页: 1 [2]
查看完整版本: 悬赏标注检查