自贡黄明儒 发表于 2013-6-27 11:55:02

尺寸对齐

本帖最后由 自贡黄明儒 于 2013-6-28 12:07 编辑

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

      (if (and ss1 (> (sslength ss1) 1))
      (HH:dimAliDo ss1)
      )
    )
    ;;4 主程序
    (princ "\n 第一选择或者生成的尺寸为对齐基准,请框选尺寸:")
    (setvar "nomutt" 1)
    (setq ss (ssget '((0 . "DIMENSION") (100 . "AcDbAlignedDimension"))))
    (setvar "nomutt" 0)
    (command "_.undo" "be")
    (if      (and ss (> (sslength ss) 1))
      (progn
      (vlax-for x
                  (vla-get-ActiveSelectionSet
                      (vla-get-ActiveDocument (vlax-get-acad-object))
                  )
          (vlax-put x 'TextMovement 0)
      )
      (HH:dimAliDo ss)
      )
    )
    (command "_.undo" "e")
    (gc)
    (princ)
)

meja 发表于 2023-8-22 08:48:07

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

行天下 发表于 2023-9-10 15:04:13


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

monsterWu 发表于 2018-9-4 06:06:09

感謝樓主無私分享

朽木大师 发表于 2013-6-27 12:50:41

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

kizj 发表于 2013-6-27 16:41:35

坐标标注有效否、

yaokui25 发表于 2013-6-27 21:24:16

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

自贡黄明儒 发表于 2013-6-27 21:45:47

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

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

yaokui25 发表于 2013-6-27 21:49:43

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

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

ymcui 发表于 2013-6-28 10:45:31

谢谢楼主

hyong10000 发表于 2013-7-4 09:51:38

谢谢楼主谢谢楼主

云中孤鹰 发表于 2013-7-5 10:17:23

支持楼主，收藏备用

yoyoho 发表于 2015-9-30 15:28:46

支持楼主，收藏备用!!!!!
页: [1] 2
查看完整版本: 尺寸对齐