文字对齐到最近的LINE,POLYLINE

tianyu229 · 发表于 2020-6-3 15:08:20

好东西学习学习

xujinhua · 发表于 2020-6-3 19:05:43

谢谢你，正在学习这方面的

vpddup · 发表于 2020-6-4 20:11:08

看看怎么实现

sammy_crysis · 发表于 2020-7-9 15:07:05

学习一下

NET-JOB · 发表于 2020-7-26 11:23:59

感谢分享，谢谢

吴外安放 · 发表于 2020-7-26 11:57:38

学习一下，谢谢

qsxdcad · 发表于 2020-8-22 11:53:18

来学习一下啊

shenyaocan · 发表于 2020-8-22 12:16:33

8错8错8错8错8错8错

晨曦CAD · 发表于 2020-8-25 11:14:00

感谢分享，66666

ketxu · 发表于 2020-8-25 12:07:30

Add Mtext, Spline to process and Maximum of distance that Text will be Align

(defun c:tt (/ _aap l lines p p2 ss text eg fuzz_ratio)
(setq fuzz_ratio 5) ;distance max to change 5*h
(defun _aap (ename pt / param)
(if (and (not
(vl-catch-all-error-p
(vl-catch-all-apply 'vlax-curve-getendparam (list ename))
)
)
(setq param (vlax-curve-getparamatpoint ename pt))
)
(angle '(0 0) (vlax-curve-getfirstderiv ename param))
)
)
(if (setq ss (ssget '((0 . "*polyline,Line,*Text,spline"))))
(progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT" )
(setq text (cons x text))
(setq lines (cons x lines))
)
)
(if lines
(foreach x text
(setq p (cdr (assoc 10 (setq eg (entget x)))))
(setq l (mapcar '(lambda (x)
(list (setq p2 (vlax-curve-getclosestpointto x p))
(distance p p2)
(_aap x p2)
)
)
lines
)
)
(setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b))))))
(if (<= (cadr l) (* fuzz_ratio (cdr (assoc 40 eg))))
(entmod
(subst (cons 50 (caddr l)) (assoc 50 eg) eg)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ _aap l lines p p2 ss text eg fuzz_ratio) 
(setq fuzz_ratio 5) ;distance max to change 5*h 
  (defun _aap (ename pt / param) 
    (if (and (not 
               (vl-catch-all-error-p 
                 (vl-catch-all-apply 'vlax-curve-getendparam (list ename)) 
               ) 
             ) 
             (setq param (vlax-curve-getparamatpoint ename pt)) 
        ) 
      (angle '(0 0) (vlax-curve-getfirstderiv ename param)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "*polyline,Line,*Text,spline")))) 
    (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) 
             (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT" ) 
               (setq text (cons x text)) 
               (setq lines (cons x lines)) 
             ) 
           ) 
           (if lines 
             (foreach x text 
               (setq p (cdr (assoc 10 (setq eg (entget x))))) 
               (setq l (mapcar '(lambda (x) 
                                  (list (setq p2 (vlax-curve-getclosestpointto x p)) 
                                        (distance p p2) 
                                        (_aap x p2) 
                                  ) 
                                ) 
                               lines 
                       ) 
               ) 
               (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) 
               (if (<= (cadr l) (* fuzz_ratio (cdr (assoc 40 eg)))) 
                 (entmod 
                   (subst (cons 50 (caddr l)) (assoc 50 eg) eg) 
                 ) 
                ) 
             ) 
           ) 
    ) 
  ) 
  (princ) 
)

虎躯一震 · 发表于 2020-9-2 16:39:54

谢谢分享,谢谢分享，谢谢分享

Wu_Enwu · 发表于 2020-9-10 20:40:29

感谢分享！

jinwei66 · 发表于 2020-9-22 09:18:07

这外对设计有些处

2996069566 · 发表于 2020-9-27 09:01:01

感谢！！！！！！！！！！

whuluqw · 发表于 2020-10-30 00:44:39

正好是我需要的功能

帐号		自动登录	找回密码
密码			立即注册

[每日一码] 文字对齐到最近的LINE,POLYLINE