检查尺寸是否标注在端点、交点、中点

自贡黄明儒

;;检查尺寸是否标注在端点、交点、中点，否则尺寸标注可能有误-------------自贡黄明儒 2013年5月7日

1.   ;;检查尺寸是否标注在端点、交点、中点，否则尺寸标注可能有误-------------自贡黄明儒 2013年5月7日
   
2.   ;;6.1  返回当前视窗左下角和右上角 坐标
   
3.   (defun viewpnts (/ a b c d x)
   
4.     (setq b (getvar "viewsize")
   
5.           c (car (getvar "screensize"))
   
6.           d (cadr (getvar "screensize"))
   
7.           a (* b (/ c d))
   
8.           x (setq x (getvar "viewctr"))
   
9.           x (trans x 1 2)
   
10.           c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
    
11.           d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
    
12.           c (trans c 2 1)
    
13.           d (trans d 2 1)
    
14.     )
    
15.     (list c d)
    
16.   )
    
17.   ;;6.2 功能：尺寸起末点不在线端点数值显示红色
    
18.   (defun CheckDimesionEndPoint
    
19.          (/ ENT I LST NAME POINT13 POINT14 PT3 PT4 SS)
    
20.     (setq lst (viewpnts))
    
21.     (if        (setq ss (ssget "W" (car lst) (cadr lst) '((0 . "DIMENSION"))))
    
22.       (progn ;;(command "._zoom" "_E")
    
23.              (repeat (setq i (sslength ss))
    
24.                (setq name (ssname ss (setq i (1- i)))
    
25.                      ent  (entget name)
    
26.                )
    
27.                (setq point13 (cdr (assoc 13 ent)))
    
28.                (setq point14 (cdr (assoc 14 ent)))
    
29.                (setq pt3 (osnap point13 "_end,_int,_cen"))
    
30.                (setq pt4 (osnap point14 "_end,_int,_cen"))
    
31.                (if (and        (equal point13 pt3 0.0001)
    
32.                         (equal point14 pt4 0.0001)
    
33.                    )
    
34.                  nil
    
35.                  (vlax-put-property
    
36.                    (vlax-ename->vla-object name)
    
37.                    "textcolor"
    
38.                    1
    
39.                  )
    
40.                )
    
41.              )
    
42.       )
    
43.     )
    
44.     ;;(command "._zoom" "_P")
    
45.     (princ)
    
46.   )
    

  ;;检查尺寸是否标注在端点、交点、中点，否则尺寸标注可能有误-------------自贡黄明儒 2013年5月7日<br />   ;;6.1  返回当前视窗左下角和右上角 坐标<br />   (defun viewpnts (/ a b c d x)<br />     (setq b (getvar "viewsize")<br />           c (car (getvar "screensize"))<br />           d (cadr (getvar "screensize"))<br />           a (* b (/ c d))<br />           x (setq x (getvar "viewctr"))<br />           x (trans x 1 2)<br />           c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)<br />           d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)<br />           c (trans c 2 1)<br />           d (trans d 2 1)<br />     )<br />     (list c d)<br />   )<br />   ;;6.2 功能：尺寸起末点不在线端点数值显示红色<br />   (defun CheckDimesionEndPoint<br />          (/ ENT I LST NAME POINT13 POINT14 PT3 PT4 SS)<br />     (setq lst (viewpnts))<br />     (if        (setq ss (ssget "W" (car lst) (cadr lst) '((0 . "DIMENSION"))))<br />       (progn ;;(command "._zoom" "_E")<br />              (repeat (setq i (sslength ss))<br />                (setq name (ssname ss (setq i (1- i)))<br />                      ent  (entget name)<br />                )<br />                (setq point13 (cdr (assoc 13 ent)))<br />                (setq point14 (cdr (assoc 14 ent)))<br />                (setq pt3 (osnap point13 "_end,_int,_cen"))<br />                (setq pt4 (osnap point14 "_end,_int,_cen"))<br />                (if (and        (equal point13 pt3 0.0001)<br />                         (equal point14 pt4 0.0001)<br />                    )<br />                  nil<br />                  (vlax-put-property<br />                    (vlax-ename->vla-object name)<br />                    "textcolor"<br />                    1<br />                  )<br />                )<br />              )<br />       )<br />     )<br />     ;;(command "._zoom" "_P")<br />     (princ)<br />   )<br />

yaokui25

请问楼主，执行命令是什么？

yaokui25

yaokui25 发表于 2013-5-7 11:52
请问楼主，执行命令是什么？

谢谢，下载试试

风雨依然

没命令不会用 单要顶起啊  强大

haoryh

顶一个，黄兄那个删除重叠标注的能修改一下不？好像运行不了！

adc

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

mjz521yy

请问楼主，执行命令是什么？

tigcat

这个好，感谢黄大师