文字动态对齐线（直线、多段线、曲线化的多段线、spl线）

得瑟的猫

感谢楼主和楼上修改代码的大神！

依然小小鸟

能帮忙修改为块或者任意实体齐线吗

lg328084985

学习一下，。。

依然小小鸟

尘缘一生 发表于 2018-7-22 06:36
我提的问题，还得我来修改？没有明白我得意思的？
下面发上代码：

能帮忙修改为块或者任意实体齐线吗

enn09

很少用到曲线，学习了

479274135

过来学习学习，谢谢分享

bai2000

我也上传个文字复制并齐线的工具，出来不支持多段线、圆弧外都很完美、希望大神没改造一下支持多段线


(vl-load-com)
(defun c:wzqx (/ ent enl pt1 pt2 mid_pt ang)
  (defun emk_t (layer pt1 pt2 text ang n72 n73 h w sty /)
    (entmake (list '(0 . "text")
     '(100 . "AcDbEntity")
     (cons 8 layer)
     '(100 . "AcDbText")
     (cons 10 pt1)
     (cons 1 text)
     (cons 40 h)
     (cons 41 w)
     (cons 7 sty)
     (cons 72 n72)
     (cons 11 pt2)
     (cons 50 ang)
     (cons 73 n73)
      )
    )
  )
  (setq ent (car (entsel "\n选择文字：")))
  (if (= "TEXT" (cdr (assoc 0 (entget ent))))
    (progn
      (while (setq enl (entsel "\n选择对齐线："))
(if (= "LINE" (cdr (assoc 0 (entget (car enl)))))
   (progn
     (setq pt1  (cdr (assoc 10 (entget (car enl))))
    pt2  (cdr (assoc 11 (entget (car enl))))
    mid_pt (vlax-curve-getClosestPointTo
      (vlax-ename->vla-object (car enl))
      (cadr enl)
    )
    ang  (angle pt1 pt2)
     )
     (if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5)))
       (setq ang (- ang pi))
     )
     (emk_t (cdr (assoc 8 (entget ent)))
     '(0 0 0)
     (polar mid_pt (+ ang (* 0.5 pi)) 100)
     (cdr (assoc 1 (entget ent)))
     ang
     1
     0
     (cdr (assoc 40 (entget ent)))
     (cdr (assoc 41 (entget ent)))
     (cdr (assoc 7 (entget ent)))
     )
   )
)
      )
    )
  )
  (princ)
)

心中的梦想

收藏了，谢谢分享！！！！！

luhy2008

感谢楼主分享!

bluefcc1

感谢楼主分享!