为什么任兵 发表于 2012-3-11 11:45:48

悬赏标注检查

请看截图
请高手帮忙解决一下！！！就是尺寸没有在线上，或者点上， 检查支持框选

langjs 发表于 2012-3-11 11:45:49

一个类似作用的
;;; ======================================
;;; 名称: 尺寸检查
;;; 功能：尺寸起末点不在线端点数值显示红色
;;; ======================================
(defun c:aa (/ ent i lst name p ss ss0 x)
(defun zz002 (pt lst / p x)
    (setq p nil)
    (foreach x lst (if (and (= (car x) (car pt)) (= (cadr x) (cadr pt)))(setq p t))) p
)
(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)(progn (vlax-put-property (vlax-ename->vla-object name) "textcolor" 256) (setq p nil))))
)
(if p
    (progn
      (if (setq ss (ssget "X" '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,PLINE"))))
        (repeat (setq i (sslength ss))
          (setq name (ssname ss (setq i (1- i))) ent (entget name) type (cdr (assoc 0 ent)))
          (cond
          ((member type '("PLINE" "LWPOLYLINE"))
             (foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst)))))
          (t (setq lst (cons (cdr (assoc 10 ent)) lst))
              (if (= type "LINE")(setq lst (cons (cdr (assoc 11 ent)) lst)))
              (if (= type "ARC")
                (setq lst (cons (polar (cdr (assoc 10 ent)) (cdr (assoc 50 ent)) (cdr (assoc 40 ent))) lst)
                      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))) ent (entget name))
          (if (and (zz002 (cdr (assoc 13 ent)) lst) (zz002 (cdr (assoc 14 ent)) lst))
          (princ)
          (vlax-put-property (vlax-ename->vla-object name) "textcolor" 1)
          )
        )
      )
    )
)
(princ)
)

为什么任兵 发表于 2012-3-11 13:10:06

请求高手！！！！

lidaxiu 发表于 2012-3-11 15:29:53

还是不太明白想法

为什么任兵 发表于 2012-3-11 16:45:31

就是检查 标注，不在线上，或者点上，

为什么任兵 发表于 2012-3-11 16:53:08

有的时候，着急，就把尺寸标偏了，没标在点上，或者线上，
我主要是想要能检查出来这种情况的LISP！！

为什么任兵 发表于 2012-3-11 16:53:54

看上面的521 就是标偏了，实际要是标在点上，就500

xotoo 发表于 2012-3-11 19:23:53

不错不错，谢谢7楼

为什么任兵 发表于 2012-3-12 18:19:54

多谢lang兄。要是能把标记的尺寸分到别的图层，就更完美了， 希望lang兄更新一下！！！！

vlisp2012 发表于 2012-3-12 21:08:28

多谢谢langjs大侠，和你学习了很多！！！！！
页: [1] 2
查看完整版本: 悬赏标注检查