[已解决]标注重叠快速检查工具

st788796 · 发表于 2013-11-13 22:44:29

金鹅起飞发表于 2013-11-13 21:41
st788796大师：您好！感谢您的程序，谢谢！我刚才试了一下，发现可以判断重叠尺寸，真是太好了！如果能够 ...

主要是有没有漏掉的，变色就是加一句代码，如变红色
(xdrx_entity_setcolor ll 1)

金鹅起飞 · 发表于 2013-11-13 22:54:30

st788796 发表于 2013-11-13 22:44
主要是有没有漏掉的，变色就是加一句代码，如变红色
(xdrx_entity_setcolor ll 1)

漏掉的到没有，就是最外面的尺寸，总尺寸也亮显了，这个有误。谢谢！还有，改变颜色的代码复制到哪里？

st788796 · 发表于 2013-11-13 23:34:17

金鹅起飞发表于 2013-11-13 22:54
漏掉的到没有，就是最外面的尺寸，总尺寸也亮显了，这个有误。谢谢！还有，改变颜色的代码复制到哪里？

放到if ll内部

(if ll
(progn
(xdrx_entity_setcolor (setq s (XD::Entity->Pickset ll)) 1)
(sssetfirst nil s)
)
)

st788796 · 发表于 2013-11-14 08:26:44

金鹅起飞发表于 2013-11-13 22:54
漏掉的到没有，就是最外面的尺寸，总尺寸也亮显了，这个有误。谢谢！还有，改变颜色的代码复制到哪里？

再试试

(defun c:tt (/ ss el Pnts:SameLine el1 l1 l2 p1 p2 p3 p4 pts1 pts2 ll )
(defun Pnts:SameLine (p1 p2 p3 p4 / v1 v2 v3)
(setq v1 (xdrx_vector_normalize (mapcar '- p2 p1))
v2 (xdrx_vector_normalize (mapcar '- p3 p4))
v3 (xdrx_vector_normalize
(mapcar '- (xdrx_line_midp p1 p2) (xdrx_line_midp p3 p4))
)
)
(and (equal (abs (xdrx_vector_dotproduct v1 v2)) 1. 1e-5)
(equal (abs (xdrx_vector_dotproduct v1 v3)) 1. 1e-5)
)
)
(if (setq ss (ssget '((0 . "Dimension"))))
(progn
(setq el (vl-remove-if-not
'(lambda (x)
(vl-position
(xdrx_getpropertyvalue x "IsA")
'("AcDbAlignedDimension" "AcDbRotatedDimension")
)
)
(xdrx_pickset->ents ss)
)
el (vl-sort el
'(lambda (e1 e2)
(< (xdrx_getpropertyvalue e1 "Measurement")
(xdrx_getpropertyvalue e2 "Measurement")
)
)
)
el (mapcar '(lambda (x)
(cons x (xdrx_entity_getstretchpoint x))
)
el
)
)
(while el
(setq l1 (car el)
el1 (cdr el)
p1 (nth 3 l1)
p2 (nth 4 l1)
pts1 (reverse (cdr (reverse (cdr l1))))
)
(while el1
(setq l2 (car el1)
p3 (nth 3 l2)
p4 (nth 4 l2)
pts2 (reverse (cdr (reverse (cdr l2))))
)
(if
(and
(Pnts:SameLine p1 p2 p3 p4)
(> (length (xdrx_points_boundingboxintersect pts1 pts2))
2
)
)
(setq ll (cons (car l2) ll))
)
(setq el1 (cdr el1))
)
(setq el (cdr el))
)
(if ll
(progn
(mapcar '(lambda (x)
(mapcar '(lambda (a) (xdrx_setpropertyvalue x a 1))
'("Dimclrd" "Dimclre" "Dimclrt")
)
)
ll
)
(sssetfirst nil (XD::Entity->Pickset ll))
)
)
)
)
(princ)
)

(defun c:tt (/ ss el Pnts:SameLine el1 l1 l2 p1 p2 p3 p4 pts1 pts2 ll ) 
  (defun Pnts:SameLine (p1 p2 p3 p4 / v1 v2 v3) 
    (setq v1 (xdrx_vector_normalize (mapcar '- p2 p1)) 
          v2 (xdrx_vector_normalize (mapcar '- p3 p4)) 
          v3 (xdrx_vector_normalize 
               (mapcar '- (xdrx_line_midp p1 p2) (xdrx_line_midp p3 p4)) 
             ) 
    ) 
    (and (equal (abs (xdrx_vector_dotproduct v1 v2)) 1. 1e-5) 
         (equal (abs (xdrx_vector_dotproduct v1 v3)) 1. 1e-5) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "Dimension")))) 
    (progn 
      (setq el (vl-remove-if-not 
                 '(lambda (x) 
                    (vl-position 
                      (xdrx_getpropertyvalue x "IsA") 
                      '("AcDbAlignedDimension" "AcDbRotatedDimension") 
                    ) 
                  ) 
                 (xdrx_pickset->ents ss) 
               ) 
            el (vl-sort        el 
                        '(lambda (e1 e2) 
                           (< (xdrx_getpropertyvalue e1 "Measurement") 
                              (xdrx_getpropertyvalue e2 "Measurement") 
                           ) 
                         ) 
               ) 
            el (mapcar '(lambda        (x) 
                          (cons x (xdrx_entity_getstretchpoint x)) 
                        ) 
                       el 
               ) 
      ) 
      (while el 
        (setq l1   (car el) 
              el1  (cdr el) 
              p1   (nth 3 l1) 
              p2   (nth 4 l1) 
              pts1 (reverse (cdr (reverse (cdr l1)))) 
        ) 
        (while el1 
          (setq        l2   (car el1) 
                p3   (nth 3 l2) 
                p4   (nth 4 l2) 
                pts2 (reverse (cdr (reverse (cdr l2)))) 
          ) 
          (if 
            (and 
              (Pnts:SameLine p1 p2 p3 p4) 
              (> (length (xdrx_points_boundingboxintersect pts1 pts2)) 
                 2 
              )       
            ) 
             (setq ll (cons (car l2) ll)) 
          ) 
          (setq el1 (cdr el1)) 
        ) 
        (setq el (cdr el)) 
      ) 
      (if ll 
        (progn 
          (mapcar '(lambda (x) 
                     (mapcar '(lambda (a) (xdrx_setpropertyvalue x a 1)) 
                             '("Dimclrd" "Dimclre" "Dimclrt") 
                     ) 
                   ) 
                  ll 
          ) 
          (sssetfirst nil (XD::Entity->Pickset ll)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

金鹅起飞 · 发表于 2013-11-14 08:41:29

st788796 发表于 2013-11-14 08:26
再试试

ST788796大师：太谢谢您了！这次成功了！可以框选所有标注让重叠的尺寸变色显示出来，演示图片如下。晓东CAD家园，非常好！我们支持您！感谢所有帮助过这个程序的大师们！

st788796 · 发表于 2013-11-14 08:44:57

金鹅起飞发表于 2013-11-14 08:41
ST788796大师：太谢谢您了！这次成功了！可以框选所有标注让重叠的尺寸变色显示出来，演示图片如下。晓东 ...

欢迎常来，编辑下标题吧 [以解决]

还需要增加手动修改尺寸的检查吗？

金鹅起飞 · 发表于 2013-11-14 11:01:42

st788796 发表于 2013-11-14 08:44
欢迎常来，编辑下标题吧 [以解决]

还需要增加手动修改尺寸的检查吗？

谢谢您！那更好了，麻烦您再往程序里增加手动改后变色的程序吧，辛苦您了！

newer · 发表于 2013-11-14 11:14:48

st788796 发表于 2013-11-14 08:44
欢迎常来，编辑下标题吧 [以解决]

还需要增加手动修改尺寸的检查吗？

我觉得变色也不醒目，如果图很大，还是在有重合的地方，插个云状线吧，然后提供逐个的缩放查询，最后增加个工具删除所有的云线。

金鹅起飞 · 发表于 2013-11-14 11:23:52

newer 发表于 2013-11-14 11:14
我觉得变色也不醒目，如果图很大，还是在有重合的地方，插个云状线吧，然后提供逐个的缩放查询，最后增加 ...

newer：大师：您好！您的建议好，这样就可以完全杜绝标注出错了，感谢！可以劳驾您写一个吗？谢谢了。

st788796 · 发表于 2013-11-14 11:56:19

可以把云线和标注编组

金鹅起飞 · 发表于 2013-11-14 12:28:37

st788796 发表于 2013-11-14 11:56
可以把云线和标注编组

云线和标注编组后，删掉云线后标注也没有了，这样不可以吧

st788796 · 发表于 2013-11-14 12:43:42

金鹅起飞发表于 2013-11-14 12:28
云线和标注编组后，删掉云线后标注也没有了，这样不可以吧

程序当然可以删一个，用命令的话先取消编组

st788796 · 发表于 2013-11-14 12:45:12

可以写个通用函数，pickset or entity BOX 云线，特殊图层

金鹅起飞 · 发表于 2013-11-14 13:05:43

st788796 发表于 2013-11-14 12:45
可以写个通用函数，pickset or entity BOX 云线，特殊图层

好吧，谢谢您了。

kocer · 发表于 2014-7-8 16:14:43

不是一点的强啊，非常佩服

账号		自动登录	找回密码
密码			立即注册

[已解决] [已解决]标注重叠快速检查工具

点评

点评

点评

点评

点评

点评

点评

点评

点评