标注对齐命令 tdx

edata

;标注对齐命令 tdx
;2013-12-23~24 by edata
;cad 2006 wcs/ucs 没问题
;只支持转角标注和对齐标注
;引线只修改第一点
;对于标注的尺寸界线原点和和尺寸线的点重合，有很好的处理方式
;因为这个所以收1个币
;引线只修改第一点
；

KO你

langjs 发表于 2014-7-5 14:34
感觉没我的标注整理效果好

狼大师的标注对齐也是我最喜欢的(稳定)
优点--转角标注在文字避让的情况下也可以对齐。
缺点--不支持对齐标注，要是转角标注与对齐标注都支持就完美了。

EDATA大师的对齐(功能多)

优点--转角标注与对齐标注都支持，也支持引线箭头对齐
缺点--避让文字或者移位的标注不支持对齐，有BUG，有时尺寸会飞得很远或者失灵。

根据小弟使用两位大佬的工具常遇问题评论，不对的地方勿喷

罗尼

KO你 发表于 2022-11-6 21:32
狼大师的标注对齐也是我最喜欢的(稳定)
优点--转角标注在文字避让的情况下也可以对齐。
缺点--不支持对 ...

langjs大师的确实好，一直在用

eii

挺不错的，和贱人的有一比了，另外，我遇到一个小bug，可能是楼主说的bug

lostbalance

看了半天终于看懂什么意思了。
感觉用处不是很大，比较适合有点强迫症的人吧
建议像cad自带的标注间距一样，实现多个标注同时对齐

1993063

感觉用处不是很大

ctclsc

这么简单的代码还要明经币？？？

ctclsc

;标注对齐命令 tdx
;2013-12-23~24 by edata
;cad 2006 wcs/ucs 没问题
;只支持转角标注和对齐标注
;引线只修改第一点
(defun c:tdx(/ ANG E EN N10 N13 N14 O10 O13 O14 O42 P1 P2 SS K13 LE10 LE11 NLE10)
  (defun *error*_New (msg)
  (vl-load-com)
  (if *error*_Old(setq *error* *error*_Old))
  (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")   
    (princ)
  )
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (princ)
)
  (setq *error*_Old *error*)
(setq *error* *error*_New)
  ;;;计算cp到p1 p2的垂足点 gu_xl
(defun PerToLine  (cp p1 p2 / norm)
  (setq        norm (mapcar '- p2 p1)
        p1   (trans p1 0 norm)
        cp   (trans cp 0 norm)
        )
  (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
  )
  ;;;判断三点共线 highflybird
(defun LINE:Colinearity (p1 p2 p3 / a b c eps)
  (setq eps 1e-8)
  (setq a (distance p2 p3))
  (setq b (distance p3 p1))
  (setq c (distance p1 p2))
  (or (equal (+ a b) c eps)
      (equal (+ b c) a eps)
      (equal (+ c a) b eps)
      )
  )
  ;;;已知斜边两点和另一边,求直角三角形直角点坐标
  (defun sk_djp3(p1 p2 ds / A ANG B C D H PT1 QQ S XD)
  (if (and p1 p2 ds)
    (progn
      (setq c(distance p1 p2)
            a ds
            b (sqrt (abs(- (* c c) (* a a))))
            ang(angle p1 p2)
            pt1 p1)
      (setq qq (/ (+ a b c) 2.0))
      (setq s (sqrt (abs(* qq (- qq a) (- qq b) (- qq c)))))
      (setq h (/ (* s 2.0) c))
      (setq d (sqrt (abs(- (* a a) (* h h)))))
      (setq xd(polar pt1 ang d))
      (polar xd (+ ang (* pi 0.5)) h)
      )
    )
  )
;;;取得图元名的组码值
  (defun sK_dxf(en code / e)
  (setq e(entget en))
  (cdr (assoc code e)))
  ;;;主程序
  (if(setq ss(ssget '((-4 . "<or")
                      (-4 . "<and")
                      (0 . "DIMENSION")
                      (-4 . "<or")
                      (70 . 33)
                      (70 . 32)
                      (-4 . "or>")
                      (-4 . "and>")
                      (0 . "LEADER")
                      (-4 . "or>")
                      )
                    )
           )
  (if (setq p1(getpoint "\n指定新的尺寸界线原点<不改动>:"))
    (setq p2(getpoint p1 "\n指定新的尺寸线位置<不改动>:"))
    (setq p2(getpoint "\n指定新的尺寸线位置<不改动>:"))))
  (if (and ss (or p1 p2))           
    (progn
      (and p1(setq p1(trans p1 1 0)))
      (and p2(setq p2(trans p2 1 0)))
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (while (setq en (ssname ss 0))
        (setq e(entget en))
        (cond
          ((and (= (sK_dxf en 0) "DIMENSION")(member (sK_dxf en 70) (list 32 33)))
           (setq o13(sK_dxf en 13)
                 o14(sK_dxf en 14)
                 o10(sK_dxf en 10)
                 o42(sK_dxf en 42))
           (setq k13 (sk_djp3 o10 o13 o42))
           (cond
             ((and (equal o14 o10 1e-8)(not (equal o13 k13 1e-8))) ;(princ"\n两点共线")
              (setq o14 (sk_djp3 o13 o10 o42))
              )
             ((and (LINE:Colinearity o10 o13 o14) ) ;(princ"\n三点共线")
                  (setq o14 (polar o14 (+ (angle o13 o14) (* pi 0.5)) 10))
                  (setq o13 (polar o13 (+ (angle o13 o14) (* pi 0.5)) 10))
                  )                  
                 )
           (and p1  (setq n14(PerToLine p1 o14 o10)
                          ang(angle (PerToLine o13  o14 o10)  o13)
                          n13(polar n14 ang o42)
                          ))
           (and p2 (setq n10(PerToLine p2 o14 o10)))                  
           (and n13(setq e(subst (cons 13 n13)(assoc 13 e) e)))
           (and n14(setq e(subst (cons 14 n14)(assoc 14 e) e)))
           (and n10(setq e(subst (cons 10 n10)(assoc 10 e) e)))
           (and e(entmod e))          
           )
          ((and (= (sK_dxf en 0) "LEADER") p1)
           (setq le10 (vlax-curve-getPointAtParam en 0))
           (setq le11 (vlax-curve-getPointAtParam en 1))
           (setq nle10 (PerToLine p1 le11 le10))
           (entmod (subst (cons 10 nle10)(assoc 10 e) e))
           ;(vlax-curve-getPointAtParam en 2)
           )
          );cond
        (setq ss(ssdel en ss))
        )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
    )
  (princ)
  )
(vl-load-com)
(prompt"\n标注对齐命令 tdx")
(princ)

混沌初开

楼主能否贴个图，有点看不明白！来自: Android客户端

328302216

楼主的帖还真没看懂...好像都是CAD自带的操作演示

dforme

感谢楼主，感谢 ctclsc，倾斜的标注也能对齐

edata

话说这是一个伤心的帖子。。。
其实这个也有个bug，没心情修复了。

自贡黄明儒

edata 发表于 2014-7-4 14:24
话说这是一个伤心的帖子。。。
其实这个也有个bug，没心情修复了。

尺寸是不容易搞肯的，我也没有搞定。关键它的夹点，动一下之后，修改组码13 14不行了。