尺寸重叠检查

adc

有时候尺寸标注会有重叠，这种情况很难检查，希望能有个程序可以检查出这种情况。详见附件

yjr111

2. (defun c:tt(/ E SS SS1 SS2 N P1 P2 LSTSS1 LSTSS2 SSS)
   
3.   (defun getdxf(s num)(cdr(assoc num s)))
   
4.   (setq ss(ssget '((0  . "dimension"))) n 0 SSS (SSADD))
   
5.   (repeat (sslength ss)
   
6.     (setq e(ssname ss n)
   
7.           s(entget e)
   
8.           p1(getdxf s 10)
   
9.           clz1(abs(-(car(getdxf s 13))(car(getdxf s 14))))
   
10.           clz2(abs(-(cadr(getdxf s 13))(cadr(getdxf s 14))))
    
11.           P2(list (- (car p1)clz1)(- (cadr p1)clz2)(caddr p1))
    
12.           )
    
13.     (SETQ SS1(SSGET "C" P1 P1 '((0  . "dimension")))
    
14.           LSTSS1(SS2LST SS1)
    
15.           SS2(SSGET "C" P2  P2 '((0  . "dimension")))
    
16.           LSTSS2(SS2LST SS2)
    
17.           )
    
18.     (if (and ss1 ss2)
    
19.       (progn
    
20.     (SSDEL E SS1)
    
21.     (SSDEL E SS2)
    
22.     (IF (AND (EQUAL LSTSS1 LSTSS2)
    
23.              (>(LENGTH LSTSS1)0)
    
24.              (>(LENGTH LSTSS2)0)
    
25.              )
    
26.       (repeat(setq m(sslength ss1))
    
27.              (SSADD (ssname ss1(setq m(1- m))) SSS)
    
28.       )
    
29.     )
    
30.    )
    
31.   )
    
32. (setq n(1+ n))
    
33. )
    
34. (SSSETFIRST SSS SSS)
    
35. (princ)
    
36. )
    
37. (defun ss2lst (ss / nn ee lst)
    
38. (if ss
    
39. (repeat (setq nn (sslength ss))
    
40.   (setq  lst (cons (ssname ss (setq nn (1- nn))) lst))  
    
41. )
    
42. )
    
43. )

(defun c:tt(/ E SS SS1 SS2 N P1 P2 LSTSS1 LSTSS2 SSS)<br />   (defun getdxf(s num)(cdr(assoc num s)))<br />   (setq ss(ssget '((0  . "dimension"))) n 0 SSS (SSADD))<br />   (repeat (sslength ss)<br />     (setq e(ssname ss n)<br />           s(entget e)<br />           p1(getdxf s 10)<br />           clz1(abs(-(car(getdxf s 13))(car(getdxf s 14))))<br />           clz2(abs(-(cadr(getdxf s 13))(cadr(getdxf s 14))))<br />           P2(list (- (car p1)clz1)(- (cadr p1)clz2)(caddr p1))<br />           )<br />     (SETQ SS1(SSGET "C" P1 P1 '((0  . "dimension")))<br />           LSTSS1(SS2LST SS1)<br />           SS2(SSGET "C" P2  P2 '((0  . "dimension")))<br />           LSTSS2(SS2LST SS2)<br />           )<br />     (if (and ss1 ss2)<br />       (progn<br />     (SSDEL E SS1)<br />     (SSDEL E SS2)<br />     (IF (AND (EQUAL LSTSS1 LSTSS2)<br />              (>(LENGTH LSTSS1)0)<br />              (>(LENGTH LSTSS2)0)<br />              )<br />       (repeat(setq m(sslength ss1))<br />              (SSADD (ssname ss1(setq m(1- m))) SSS)<br />       )<br />     )<br />    )<br />   )<br /> (setq n(1+ n))<br /> )<br /> (SSSETFIRST SSS SSS)<br /> (princ)<br /> )<br /> (defun ss2lst (ss / nn ee lst)<br /> (if ss<br /> (repeat (setq nn (sslength ss))<br />   (setq  lst (cons (ssname ss (setq nn (1- nn))) lst))  <br /> )<br /> )<br /> )

yjr111

yjr111

yjr111 发表于 2013-1-4 14:37

我是08,xp，可以用，请上真相

adc

真相来啦

adc

adc 发表于 2013-1-4 19:37
真相来啦

我也全部重新下载了一遍，纯cad08，没加载任何插件
命令: tt
选择对象: 指定对角点: 找到 4 个，2 个编组

选择对象:  ; 错误: no function definition: SS2LST

yjr111

(defun ss2lst (ss / nn ee lst)
(repeat (setq nn (sslength ss))
  (setq  lst (cons (ssname ss (setq nn (1- nn))) lst))  
)
)

adc

yjr111 发表于 2013-1-4 20:30
(defun ss2lst (ss / nn ee lst)
(repeat (setq nn (sslength ss))
  (setq  lst (cons (ssname ss (se ...

如果选中的标注里有对齐标注，程序就不能正常执行，希望对齐标注类似的情况也能检查出来，抱歉遗漏了，加多2个币

tth02

如果标注旋转到任意角度都可用就更好了。

adc

yjr111 发表于 2013-1-4 20:30
(defun ss2lst (ss / nn ee lst)
(repeat (setq nn (sslength ss))
  (setq  lst (cons (ssname ss (se ...

严总，遇到一张图，用你的程序会出错，选中的标注都没有重叠，麻烦请看看是什么原因？