wzg356 发表于 2023-8-20 18:10:06

转角/对齐标注对齐--没写过，近几天用上刚写的分享

本帖最后由 wzg356 于 2023-8-22 11:19 编辑

很少用，临时写的，需要其他控制的自己补充。

先选要对齐的一组转角/对齐标注，再指定对齐的基准（其中一个标注）

(defun perppp (P p1 p2);垂足
(inters p1 p2 p(polar p(+ (* 0.5 pi)(angle p1 p2))10.0)nil)
)

;(dimsduiqi(setq e(car(entsel)))(setq ss(ssget)))
(defun dimsduiqi(e ss / e0 es ang ang1 e10 e13 e14 p10 p101 p13 p131 p14)      
      (setq es(entget e))
      (setq p10(cdr(assoc 10 es)))
      (setq e14(assoc 14 es) p14(cdr e14))
      (setq ang(angle p14 p10))
      (setq p101(polar p10 (+ (* pi 0.5)ang) 10))
      (setq p13(cdr(assoc 13 es)))
      (setq p131(perppp p13 p10 p14));perppp垂足函数
      (entmod(subst(cons 14 p131)e14 es))
      (repeat(setq ss1(ssadd) n(sslength ss))
                (setq e0(ssname ss(setq n(1- n))) es(entget e0))
                (setq e10(assoc 10 es) e13(assoc 13 es) e14(assoc 14 es))
                (setq ang1(- ang(angle (cdr e14)(cdr e10))))
                (if(or(equal 0 ang1 1e-6)(equal pi ang1 1e-6))(progn
                        (setq es(subst(cons 10(perppp (cdr e10) p10 p101))e10 es))
                        (setq es(subst(cons 13(perppp (cdr e13) p13 p131))e13 es))
                        (entmod(subst(cons 14(perppp (cdr e14) p13 p131))e14 es))
                        (ssadd e0 ss1)                        
                ))                                                
      )(list ang e ss1);这个数据留着扩展-下面函数使用
)

;对齐即完成
(defun c:dmdq( / e ss frs)
      (setq frs '((0 . "DIMENSION")(-4 . "<or")(70 . 32)(70 . 33)(-4 . "or>")))
      (princ"\n选择拟对齐标注集:")
      (if      (and (or(setq ss(ssget "i" frs))(setq ss(ssget frs)))
                        (sssetfirst nil ss)
                        (setq e(car(entsel " \n指定基准标注对象:")))
                        (ssmemb e ss)
                )
                (dimsduiqi e ss)
      )
)
;对齐后移动
(defun c:dmdm( / cmd ls Wob)                                                
      (if(setq ls(c:dmdq))(progn               
                (setq cmd(if command-s command-s vl-cmdf))
                (setq Wob(Vlax-Get-Or-Create-Object "WScript.Shell" ))
                (cmd "_move" (caddr ls) "" "non" (cdr(assoc 10(entget(cadr ls)))))                        
                (Vlax-Invoke-Method Wob 'Sendkeys(strcat"<"(angtos(car ls)0 4)"{Enter}"))
                (cmd pause)
                (vlax-release-object Wob)
      ))
)


ikias 发表于 2023-8-20 19:15:05

很棒。如果有图片演示将更好了。

zxh92 发表于 2023-8-20 20:01:21

如果有图片演示将更好了。

xcmdos 发表于 2023-8-20 21:31:23

放个GIF ，效果一目了然，方便大家知道效果

wzg356 发表于 2023-8-22 11:49:59

补了一张动态图

菜鸟初来乍到 发表于 2023-8-25 08:00:10

感谢大佬分享
页: [1]
查看完整版本: 转角/对齐标注对齐--没写过，近几天用上刚写的分享