尺寸对齐

自贡黄明儒

我是想一次框选，差不多在一条线的尺寸均对齐
对于尺寸，我只进行了一次预处理(vlax-put x 'TextMovement 0)，应该还有别的,等各位高手完善一下

1.   ;;2.1 首先假定一张图上标注字体是同样大小，小于字高2X认为在同一行(列)
   
2.   ;;2.2 以选择或者生成的第一个对象作为基准对象
   
3.   ;;2.3 (100 . "AcDbAlignedDimension")才能用以对齐
   
4.   (defun DimensionDimDQ        (/ SS TXTHT)
   
5.     ;;1 错误处理
   
6.     (defun *error* (s)
   
7.       (if (= 8 (logand (getvar "undoctl") 8))
   
8.         (command "_.undo" "_e")
   
9.       )
   
10.       (setvar "nomutt" 0)
    
11.     )
    
12.     ;;2 旋转一个点pnt   
    
13.     (defun rotate_pnt (pnt p1 ang)
    
14.       (polar p1 (+ (angle p1 pnt) ang) (distance p1 pnt))
    
15.     )
    
16.     ;;3 对齐
    
17.     (defun HH:dimAliDo (SS     /      ANGL0  ANGLN  DIS           EN0          ENTLIS I
    
18.                         OB0    P10    P10A   P10N   P10T   P11          P11A         P11N
    
19.                         P11P   P11PT  P14    P14N   SS1
    
20.                        )
    
21.       (setq en0           (ssname ss 0)
    
22.             ob0           (vlax-ename->vla-object en0)
    
23.             entlis (entget en0)
    
24.             p10           (cdr (assoc 10 entlis))
    
25.             P14           (cdr (assoc 14 entlis))
    
26.             P11           (cdr (assoc 11 entlis))
    
27.       )
    
28.       (ssdel en0 ss)
    
29.       (setq p10a (rotate_pnt p14 p10 (/ pi 2.0))) ;p14绕p10转90度
    
30.       (setq p11a (mapcar '+ (mapcar '- p11 p10) p10a)) ;文字方向另一点
    
31.       (setq angl0 (abs (angle p10 p14)))          ;角度
    
32.       (if (> angl0 Pi)
    
33.         (setq angl0 (rem angl0 Pi))
    
34.       )
    
35.       (if TxtHT
    
36.         nil
    
37.         (setq TxtHT
    
38.                (* (vlax-get ob0 'ScaleFactor) (vlax-get ob0 'TextHeight))
    
39.         )
    
40.                                                   ;组码10误差在此内是同行(列)
    
41.       )
    
42.       (setq ss1 (ssadd))
    
43.       (repeat (setq i (sslength ss))
    
44.         (setq en0    (ssname ss (setq i (1- i)))
    
45.               entlis (entget en0)
    
46.               p10N   (cdr (assoc 10 entlis))
    
47.               P14N   (cdr (assoc 14 entlis))
    
48.               P11N   (cdr (assoc 11 entlis))
    
49.         )
    
50.         ;;但愿基准对象的p10 p14是不等的
    
51.         (if (equal p10N P14N 0.001)
    
52.           (setq        p10N p10
    
53.                 P14N P14
    
54.           )
    
55.         )
    
56.         (setq anglN (abs (angle p10N p14N)))
    
57.         (if (> anglN pi)
    
58.           (setq anglN (rem anglN pi))
    
59.         )
    
60.         (setq P10T (inters p10 p10a p10N p14N nil))
    
61.         (setq dis (distance P10T p10N))
    
62.         ;;如果标注角度相同，高度小于字高一倍
    
63.         (if (and (equal anglN angl0 0.001) (< dis TxtHT))
    
64.           (progn
    
65.             (setq entlis (subst (cons 10 P10T) (assoc 10 entlis) entlis))
    
66.             (setq p11P (mapcar '+ (mapcar '- p11N p10N) p14N))
    
67.             (setq P11PT (inters p11P P11N p11 P11a nil))
    
68.             (entmod (subst (cons 11 P11PT) (assoc 11 entlis) entlis))
    
69.           )
    
70.           (setq ss1 (ssadd en0 ss1))
    
71.         )
    
72.       )
    
73. 
    
74.       (if (and ss1 (> (sslength ss1) 1))
    
75.         (HH:dimAliDo ss1)
    
76.       )
    
77.     )
    
78.     ;;4 主程序
    
79.     (princ "\n 第一选择或者生成的尺寸为对齐基准,请框选尺寸:")
    
80.     (setvar "nomutt" 1)
    
81.     (setq ss (ssget '((0 . "DIMENSION") (100 . "AcDbAlignedDimension"))))
    
82.     (setvar "nomutt" 0)
    
83.     (command "_.undo" "be")
    
84.     (if        (and ss (> (sslength ss) 1))
    
85.       (progn
    
86.         (vlax-for x
    
87.                     (vla-get-ActiveSelectionSet
    
88.                       (vla-get-ActiveDocument (vlax-get-acad-object))
    
89.                     )
    
90.           (vlax-put x 'TextMovement 0)
    
91.         )
    
92.         (HH:dimAliDo ss)
    
93.       )
    
94.     )
    
95.     (command "_.undo" "e")
    
96.     (gc)
    
97.     (princ)
    
98.   )

  ;;2.1 首先假定一张图上标注字体是同样大小，小于字高2X认为在同一行(列)<br />   ;;2.2 以选择或者生成的第一个对象作为基准对象<br />   ;;2.3 (100 . "AcDbAlignedDimension")才能用以对齐<br />   (defun DimensionDimDQ        (/ SS TXTHT)<br />     ;;1 错误处理<br />     (defun *error* (s)<br />       (if (= 8 (logand (getvar "undoctl") 8))<br />         (command "_.undo" "_e")<br />       )<br />       (setvar "nomutt" 0)<br />     )<br />     ;;2 旋转一个点pnt    <br />     (defun rotate_pnt (pnt p1 ang)<br />       (polar p1 (+ (angle p1 pnt) ang) (distance p1 pnt))<br />     )<br />     ;;3 对齐<br />     (defun HH:dimAliDo (SS     /      ANGL0  ANGLN  DIS           EN0          ENTLIS I<br />                         OB0    P10    P10A   P10N   P10T   P11          P11A         P11N<br />                         P11P   P11PT  P14    P14N   SS1<br />                        )<br />       (setq en0           (ssname ss 0)<br />             ob0           (vlax-ename->vla-object en0)<br />             entlis (entget en0)<br />             p10           (cdr (assoc 10 entlis))<br />             P14           (cdr (assoc 14 entlis))<br />             P11           (cdr (assoc 11 entlis))<br />       )<br />       (ssdel en0 ss)<br />       (setq p10a (rotate_pnt p14 p10 (/ pi 2.0))) ;p14绕p10转90度<br />       (setq p11a (mapcar '+ (mapcar '- p11 p10) p10a)) ;文字方向另一点<br />       (setq angl0 (abs (angle p10 p14)))          ;角度<br />       (if (> angl0 Pi)<br />         (setq angl0 (rem angl0 Pi))<br />       )<br />       (if TxtHT<br />         nil<br />         (setq TxtHT<br />                (* (vlax-get ob0 'ScaleFactor) (vlax-get ob0 'TextHeight))<br />         )<br />                                                   ;组码10误差在此内是同行(列)<br />       )<br />       (setq ss1 (ssadd))<br />       (repeat (setq i (sslength ss))<br />         (setq en0    (ssname ss (setq i (1- i)))<br />               entlis (entget en0)<br />               p10N   (cdr (assoc 10 entlis))<br />               P14N   (cdr (assoc 14 entlis))<br />               P11N   (cdr (assoc 11 entlis))<br />         )<br />         ;;但愿基准对象的p10 p14是不等的<br />         (if (equal p10N P14N 0.001)<br />           (setq        p10N p10<br />                 P14N P14<br />           )<br />         )<br />         (setq anglN (abs (angle p10N p14N)))<br />         (if (> anglN pi)<br />           (setq anglN (rem anglN pi))<br />         )<br />         (setq P10T (inters p10 p10a p10N p14N nil))<br />         (setq dis (distance P10T p10N))<br />         ;;如果标注角度相同，高度小于字高一倍<br />         (if (and (equal anglN angl0 0.001) (< dis TxtHT))<br />           (progn<br />             (setq entlis (subst (cons 10 P10T) (assoc 10 entlis) entlis))<br />             (setq p11P (mapcar '+ (mapcar '- p11N p10N) p14N))<br />             (setq P11PT (inters p11P P11N p11 P11a nil))<br />             (entmod (subst (cons 11 P11PT) (assoc 11 entlis) entlis))<br />           )<br />           (setq ss1 (ssadd en0 ss1))<br />         )<br />       )<br /> <br />       (if (and ss1 (> (sslength ss1) 1))<br />         (HH:dimAliDo ss1)<br />       )<br />     )<br />     ;;4 主程序<br />     (princ "\n 第一选择或者生成的尺寸为对齐基准,请框选尺寸:")<br />     (setvar "nomutt" 1)<br />     (setq ss (ssget '((0 . "DIMENSION") (100 . "AcDbAlignedDimension"))))<br />     (setvar "nomutt" 0)<br />     (command "_.undo" "be")<br />     (if        (and ss (> (sslength ss) 1))<br />       (progn<br />         (vlax-for x<br />                     (vla-get-ActiveSelectionSet<br />                       (vla-get-ActiveDocument (vlax-get-acad-object))<br />                     )<br />           (vlax-put x 'TextMovement 0)<br />         )<br />         (HH:dimAliDo ss)<br />       )<br />     )<br />     (command "_.undo" "e")<br />     (gc)<br />     (princ)<br />   )

meja

不是没有，是这个功能单一而已

行天下

支持楼主，收藏备用!!!!!

monsterWu

感謝樓主無私分享

朽木大师

假如水平方向有多层标注情况呢？

kizj

坐标标注有效否、

yaokui25

谢谢楼主
先占个位置，日后用得着

自贡黄明儒

yaokui25 发表于 2013-6-27 21:24
谢谢楼主
先占个位置，日后用得着

明经和晓东论坛，目前都没有完善的程序，我想有两种原因，一是高手们不屑一顾，二是有点难。我这个也是明显缺陷的

yaokui25

自贡黄明儒 发表于 2013-6-27 21:45
明经和晓东论坛，目前都没有完善的程序，我想有两种原因，一是高手们不屑一顾，二是有点难。我这个也是明 ...

楼主也是高手中的高手
做了这么多方便工作的程序，大家已经很感谢您了

ymcui

谢谢楼主

hyong10000

谢谢楼主  谢谢楼主

云中孤鹰

支持楼主，收藏备用

yoyoho

支持楼主，收藏备用!!!!!