[日积月累]：对垂直、水平标注按间距分列/行对齐(附件更新)

eachy

应一位网友所写的标注对齐程序。

注意：测试请下载附件，以下代码不能直接使用!!

2. 
   
3. (defun c:AlDim (/ ss ssl i e el p dl tf dist)
   
4.   (if (and (setq ss (ssget '((0 . "dimension") (70 . 32))))
   
5.            (setq dist (getdist "\n输入间距: "))
   
6.       )
   
7.     (progn
   
8.       (command ".undo" "be")
   
9.       (setq ssl        (sslength ss)
   
10.             i        -1
    
11.       )
    
12.       (repeat ssl
    
13.         (setq e         (ssname ss (setq i (1+ i)))
    
14.               el (entget e)
    
15.               p         (cdr (assoc 10 el))
    
16.               dl (cons (list p e) dl)
    
17.         )
    
18.         (if
    
19.           (and (not tf) (equal (cdr (assoc 50 el)) (/ pi 2.) 1e-6)) ;_ver
    
20.            (setq tf t)
    
21.         )
    
22.       )
    
23.       (if tf
    
24.         (setq dl ([URL=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/URL]  dl 1 4 dist)) ;_ver
    
25.         (setq dl ([URL=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/URL]  dl 0 1 dist))
    
26.       )
    
27.       (setq p (caaar dl))
    
28.       (foreach x dl
    
29.         (foreach d x
    
30.           (setq el (entget (cadr d)))
    
31.           (entmod (subst (cons 10
    
32.                                (if tf
    
33.                                  (list (car p) (cadar d))
    
34.                                  (list (caar d) (cadr p))
    
35.                                )
    
36.                          )
    
37.                          (assoc 10 el)
    
38.                          el
    
39.                   )
    
40.           )
    
41.         )
    
42.         (setq p        (if tf
    
43.                   (mapcar '+ (list dist 0. 0.) p)
    
44.                   (mapcar '- p (list 0. (- dist) 0.))
    
45.                 )
    
46.         )
    
47.       )
    
48.       (command ".undo" "end")
    
49.     )
    
50.   )
    
51.   (princ)
    
52. )
    
53. (princ "\nStart command with AlDim , eachy [[url]www.xdcad.net[/url]]!")
    
54. (princ)

<br /> (defun c:AlDim (/ ss ssl i e el p dl tf dist)<br />   (if (and (setq ss (ssget '((0 . "dimension") (70 . 32))))<br />            (setq dist (getdist "\n输入间距: "))<br />       )<br />     (progn<br />       (command ".undo" "be")<br />       (setq ssl        (sslength ss)<br />             i        -1<br />       )<br />       (repeat ssl<br />         (setq e         (ssname ss (setq i (1+ i)))<br />               el (entget e)<br />               p         (cdr (assoc 10 el))<br />               dl (cons (list p e) dl)<br />         )<br />         (if<br />           (and (not tf) (equal (cdr (assoc 50 el)) (/ pi 2.) 1e-6)) ;_ver<br />            (setq tf t)<br />         )<br />       )<br />       (if tf<br />         (setq dl ([URL=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/URL]  dl 1 4 dist)) ;_ver<br />         (setq dl ([URL=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/URL]  dl 0 1 dist))<br />       )<br />       (setq p (caaar dl))<br />       (foreach x dl<br />         (foreach d x<br />           (setq el (entget (cadr d)))<br />           (entmod (subst (cons 10<br />                                (if tf<br />                                  (list (car p) (cadar d))<br />                                  (list (caar d) (cadr p))<br />                                )<br />                          )<br />                          (assoc 10 el)<br />                          el<br />                   )<br />           )<br />         )<br />         (setq p        (if tf<br />                   (mapcar '+ (list dist 0. 0.) p)<br />                   (mapcar '- p (list 0. (- dist) 0.))<br />                 )<br />         )<br />       )<br />       (command ".undo" "end")<br />     )<br />   )<br />   (princ)<br /> )<br /> (princ "\nStart command with AlDim , eachy [[url]www.xdcad.net[/url]]!")<br /> (princ)

xbx7920

个人觉得没有aeo斑竹的具有相同功能的程序好。

eachy

这里有一个
http://www.xdcad.net/forum/showthread.php?s=&threadid=51960

aeo

最初由 xbx7920 发布
[B]个人觉得没有aeo斑竹的具有相同功能的程序好。 [/B]

一直想写一个圆弧标注对齐的,就是没时间.

圆弧标注要移动一下位置很麻烦,比直线的麻烦的多.

不知谁写了,省的我动脑筋.
一般的商用软件里都没有.

eachy

最初由 aeo 发布
[B]

一直想写一个圆弧标注对齐的,就是没时间.

圆弧标注要移动一下位置很麻烦,比直线的麻烦的多.

不知谁写了... [/B]

2. 
   
3. (defun c:aladim        (/ ss ssl i e el typ r dis pc dl)
   
4.   (if
   
5.     (and (setq ss (ssget '((0 . "dimension") (100 . "*AngularDimension"))))
   
6.          (setq dis (getdist "\n间距: "))
   
7.     )
   
8.      (progn
   
9.        (setq ssl (sslength ss)
   
10.              i         -1
    
11.        )
    
12.        (repeat ssl
    
13.          (setq e   (ssname ss (setq i (1+ i)))
    
14.                el  (entget e)
    
15.                typ (cdr (assoc 100 (reverse el)))
    
16.          )
    
17.          (if (wcmatch typ "*2*")
    
18.            (setq pcen (inters (cdr (assoc 10 el))
    
19.                               (cdr (assoc 15 el))
    
20.                               (cdr (assoc 14 el))
    
21.                               (cdr (assoc 13 el))
    
22.                               nil
    
23.                       )
    
24.                  r    (distance pcen (cdr (assoc 16 el)))
    
25.            )
    
26.            (setq pcen (cdr (assoc 15 el))
    
27.                  r    (distance pcen (cdr (assoc 10 el)))
    
28.            )
    
29.          )
    
30.          (setq dl (cons (list r pcen e) dl))
    
31.        )
    
32.        (setq dl ([url=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/url] dl nil nil dis))
    
33.        (setq pc        (cadaar dl)
    
34.              r        (caaar dl)
    
35.              dl        (mapcar '(lambda (x) (mapcar 'last x)) dl)
    
36.        )
    
37.        (foreach        a dl
    
38.          (foreach d a
    
39.            (setq el (entget d)
    
40.                  p  (cdr (assoc 11 el))
    
41.            )
    
42.            (entmod (subst (cons 11 (polar pc (angle pc p) r))
    
43.                           (assoc 11 el)
    
44.                           el
    
45.                    )
    
46.            )
    
47.          )
    
48.        )
    
49.        (setq r (+ r dis))
    
50.      )
    
51.   )
    
52.   (princ)
    
53. )

<br /> (defun c:aladim        (/ ss ssl i e el typ r dis pc dl)<br />   (if<br />     (and (setq ss (ssget '((0 . "dimension") (100 . "*AngularDimension"))))<br />          (setq dis (getdist "\n间距: "))<br />     )<br />      (progn<br />        (setq ssl (sslength ss)<br />              i         -1<br />        )<br />        (repeat ssl<br />          (setq e   (ssname ss (setq i (1+ i)))<br />                el  (entget e)<br />                typ (cdr (assoc 100 (reverse el)))<br />          )<br />          (if (wcmatch typ "*2*")<br />            (setq pcen (inters (cdr (assoc 10 el))<br />                               (cdr (assoc 15 el))<br />                               (cdr (assoc 14 el))<br />                               (cdr (assoc 13 el))<br />                               nil<br />                       )<br />                  r    (distance pcen (cdr (assoc 16 el)))<br />            )<br />            (setq pcen (cdr (assoc 15 el))<br />                  r    (distance pcen (cdr (assoc 10 el)))<br />            )<br />          )<br />          (setq dl (cons (list r pcen e) dl))<br />        )<br />        (setq dl ([url=http://www.xdcad.net/forum/showthread.php?postid=1609825#post1609825][color=blue][u]ea:sort_entity[/u][/color][/url] dl nil nil dis))<br />        (setq pc        (cadaar dl)<br />              r        (caaar dl)<br />              dl        (mapcar '(lambda (x) (mapcar 'last x)) dl)<br />        )<br />        (foreach        a dl<br />          (foreach d a<br />            (setq el (entget d)<br />                  p  (cdr (assoc 11 el))<br />            )<br />            (entmod (subst (cons 11 (polar pc (angle pc p) r))<br />                           (assoc 11 el)<br />                           el<br />                    )<br />            )<br />          )<br />        )<br />        (setq r (+ r dis))<br />      )<br />   )<br />   (princ)<br /> )

coolzhb

最初由 eachy 发布
[B]应一位网友所写的标注对齐程序。

注意：测试请下载附件，以下代码不能直接使用!!
[CODE]
(defun c:AlDim (/ ss ssl i e el p dl tf dist)
  (if (and (setq ss (ssget '((0 . "dimension"... [/B]

谢谢eachy版主的程序，已经达到我的要求了！

l19811102

ea的程序有个问题（不知道是不是编程思路本来就是这样），假设输入的间距是800，而如果两行尺寸之间的距离不足800，那么程序就将两行标注对齐。
是不是应该加一个开关，询问究竟是要将多行标注全部对齐，还是调整标注的间距？

eachy

最初由 l19811102 发布
[B]ea的程序有个问题（不知道是不是编程思路本来就是这样），假设输入的间距是800，而如果两行尺寸之间的距离不足800，那么程序就将两行标注对齐。
是不是应该加一个开关，询问究竟是要将多行标注全部对齐，还是调整标... [/B]

查看 ea:sort_entity 的说明文件，将dis修改为一个合适的值或者在图中指定

1. (ea:sort_entity dl nil nil [color=blue][B]dis[/B][/color]))

复制代码

monkey12

非常感谢楼主提供.......楼主,能帮俺写一个能标注当一个角度大于180度的程序吗????
万分感激!!!!

whxiwei

我看看，使用一下啊

langjs

好的，谢谢

lcl19811125

郁闷，没有爱心币，下不了！！

flowerson

版主，附件下载不了了！请帮忙查查原因。

lcl19811125

有了爱心币，下了两次都没有东西，快查查啊