社区 › 源码共享 › 【求助】拷贝文字随线角度

yangchao2005090 发表于 2018-1-5 16:03:05

【求助】拷贝文字随线角度

;;;拷贝文字随线角度 by x_s_s_1@163.com
(vl-load-com)
(defun c:ctb (/ 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)
)



上面是网上看到的源代码，遇到的问题如下：
1.只能适用于直线，pl线等无法使用，如果调整可以适合其他线性
2.文字平行线性后，距离线太远，如何调整距离

bai2000 发表于 2019-5-1 22:12:48

不错，能改为通用函数更好

w245272914 发表于 2018-1-16 09:28:47

不好用~~~~~    文字乱跑~

w245272914 发表于 2018-1-16 09:29:06

不过感谢分享源码，大神

NEWMEN 发表于 2018-1-16 12:05:27

哥们，这个求助我已经发了两次了:'(，还没有大神帮忙呢

NEWMEN 发表于 2018-1-19 12:37:44

哥们，试试这个，应该可以帮到你，我就用的这个。

NEWMEN 发表于 2018-1-19 12:38:41

要不再来一个吧，如何，里面数据可自己改一下

yjtdkj 发表于 2021-6-22 19:22:10

去看我的最新帖子
http://bbs.mjtd.com/thread-183635-1-1.html

查看完整版本: 【求助】拷贝文字随线角度