能否写一个多字随线平齐的插件？

Lisphk · 发表于 2016-4-12 14:32:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

工作中有很多时候需要将多行的文字对齐后沿着某条曲线平齐，如图：

搜狗截图20160412142546.png

要求：

1、选择多个文字
2、多行文字按照屏幕的位置排序好
3、点一条曲线，如果是弧线就切线平齐

谢谢了！

iLisp · 发表于 2016-4-13 00:44:37

供参考，因为机器上 Acad 2014 故障，没有调试

(defun c:tt (/ ss e elst p2 pt p p1 ux uy uz cv pt fvx fvy fvz h e pam mat ang)
(if (and (progn
(princ "\nSelect Text ....")
(setq ss (ssget '((0 . "text"))))
)
(progn
(princ "\nPick Curve...")
(setq e (ssget "+.:S" '((0 . "*line,arc,circle,ellipse"))))
)
)
(progn
(setq el (ssnamex e 0)
elst (mapcar '(lambda (x)
(if (not ang)
(setq ang (xdrx_getpropertyvalue x "rotation"))
)
(list (xdrx_entity_getstretchpoint x)
(xdrx_getpropertyvalue x "height")
x
)
)
(xdrx_pickset->ents ss)
)
p2 (polar '(0 0 0) ang 1.0)
elst (mapcar 'cdr
(vl-sort (mapcar '(lambda (x)
(cons (car (trans (caar x) 0 p2))
x
)
)
elst
)
'(lambda (x1 x2) (< (car x1) (car x2)))
)
)
cv (cadar el)
pt (xdrx_curve_getclosestpoint cv (last (last (car el))))
pam (xdrx_curve_getparamatpoint cv pt)
fvx (xdrx_curve_getfirstderiv cv pam)
fvy (xdrx_vector_perpvector fvx)
fvz (xdrx_vector_crossproduct fvx fvy)
)
(foreach x elst
(setq p (caar x)
p1 (polar p ang 1.0)
ux (mapcar '- p1 p)
uy (xdrx_vector_perpvector ux)
uz (xdrx_vector_crossproduct ux uy)
h (cadr x)
e (last x)
mat (xdrx_matrix_aligncoordsystem p ux uy uz pt fvx fvy fvz)
)
(xdrx_entity_transform e mat)
(setq pt (polar pt (+ ang (/ pi 2)) (* 1.5 h)))
)
)
)
(princ)
)

(defun c:tt (/ ss e elst p2 pt p p1 ux uy uz cv        pt fvx fvy fvz h e pam mat ang) 
  (if (and (progn 
             (princ "\nSelect Text ....") 
             (setq ss (ssget '((0 . "text")))) 
           ) 
           (progn 
             (princ "\nPick Curve...") 
             (setq e (ssget "+.:S" '((0 . "*line,arc,circle,ellipse")))) 
           ) 
      ) 
    (progn 
      (setq el         (ssnamex e 0) 
            elst (mapcar '(lambda (x) 
                            (if        (not ang) 
                              (setq ang (xdrx_getpropertyvalue x "rotation")) 
                            ) 
                            (list (xdrx_entity_getstretchpoint x) 
                                  (xdrx_getpropertyvalue x "height") 
                                  x 
                            ) 
                          ) 
                         (xdrx_pickset->ents ss) 
                 ) 
            p2         (polar '(0 0 0) ang 1.0) 
            elst (mapcar 'cdr 
                         (vl-sort (mapcar '(lambda (x) 
                                             (cons (car (trans (caar x) 0 p2)) 
                                                   x 
                                             ) 
                                           ) 
                                          elst 
                                  ) 
                                  '(lambda (x1 x2) (< (car x1) (car x2))) 
                         ) 
                 ) 
            cv         (cadar el) 
            pt         (xdrx_curve_getclosestpoint cv (last (last (car el)))) 
            pam         (xdrx_curve_getparamatpoint cv pt) 
            fvx         (xdrx_curve_getfirstderiv cv pam) 
            fvy         (xdrx_vector_perpvector fvx) 
            fvz         (xdrx_vector_crossproduct fvx fvy) 
      ) 
      (foreach x elst 
        (setq p          (caar x) 
              p1  (polar p ang 1.0) 
              ux  (mapcar '- p1 p) 
              uy  (xdrx_vector_perpvector ux) 
              uz  (xdrx_vector_crossproduct ux uy) 
              h          (cadr x) 
              e          (last x) 
              mat (xdrx_matrix_aligncoordsystem p ux uy uz pt fvx fvy fvz) 
        ) 
        (xdrx_entity_transform e mat) 
        (setq pt (polar pt (+ ang (/ pi 2)) (* 1.5 h))) 
      ) 
    ) 
  ) 
  (princ) 
)

_$ (xdrx_matrix_aligncoordsystem '(0. 0. 0.) '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.) '(10. 10. 0.) '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.))
nil
这个函数在我这没法用，是 ACAD 问题不是 API 原因

Lisphk · 发表于 2016-4-13 15:10:02

iLisp 发表于 2016-4-13 00:44
供参考，因为机器上 Acad 2014 故障，没有调试_$ (xdrx_matrix_aligncoordsystem '(0. 0. 0.) '(1. 0. 0.) ...

谢谢大师，我加载了，选完文字和曲线后，就结束了，没变化，帮忙再看看，谢谢了！

newer · 发表于 2016-4-13 15:17:40

iLisp 发表于 2016-4-13 00:44
供参考，因为机器上 Acad 2014 故障，没有调试_$ (xdrx_matrix_aligncoordsystem '(0. 0. 0.) '(1. 0. 0.) ...

xdrx_matrix_aligncoordsystem 的格式应该是：

(xdrx_matrix_aligncoordsystem '(from点 X轴 Y轴 Z轴) '(to点 x轴 y轴 z轴))

帮你把里面这行代码修改了，有结果了，但是如图这样的，看来还需要再改改代码。

搜狗截图20160413151331.png

iLisp · 发表于 2016-4-13 15:21:13

我这2010加载不上，2014有问题无法测试，把代码做个详细说明和算法示意吧

iLisp · 发表于 2016-4-15 01:36:29

newer 发表于 2016-4-13 15:17
xdrx_matrix_aligncoordsystem 的格式应该是：

(defun c:tt (/ ss e elst p2 pt p p1 ux uy uz cv pt fvx fvy fvz h e pam mat ang j)
(if (and (progn
(princ "\nSelect Text ....")
(setq ss (ssget '((0 . "text"))))
)
(progn
(princ "\nPick Curve...")
(setq e (ssget "+.:S" '((0 . "*line,arc,circle,ellipse"))))
)
)
(progn
(setq el (ssnamex e 0)
elst (mapcar '(lambda (x)
(cons (car (xdrx_entity_getstretchpoint x))
(cons x (xdrx_getpropertyvalue x "height" "rotation"))
)
)
(xdrx_pickset->ents ss)
)
p2 (polar '(0 0 0) (last (car elst)) 1.0)
elst (mapcar 'cdr
(vl-sort (mapcar '(lambda (x)
(cons (car (trans (car x) 0 p2))
x
)
)
elst
)
'(lambda (x1 x2) (< (car x1) (car x2)))
)
)
cv (cadar el)
pt (xdrx_curve_getclosestpoint cv (last (last (car el))))
pam (xdrx_curve_getparamatpoint cv pt)
fvx (xdrx_curve_getfirstderiv cv pam)
fvy (xdrx_vector_perpvector fvx)
fvz (xdrx_vector_crossproduct fvx fvy)
ang (angle '(0 0 0) fvy)
)
(foreach x elst
(setq p (car x)
p1 (polar p (last x) 1.0)
ux (mapcar '- p1 p)
uy (xdrx_vector_perpvector ux)
uz (xdrx_vector_crossproduct ux uy)
h (caddr x)
e (cadr x)
mat (xdrx_matrix_aligncoordsystem
(list p ux uy uz)
(list pt fvx fvy fvz)
)
)
(xdrx_entity_transform e mat)
(setq pt (polar pt ang (* 1.5 h)))
)
)
)
(princ)
)

(defun c:tt (/ ss e elst p2 pt p p1 ux uy uz cv        pt fvx fvy fvz h e pam mat ang j) 
  (if (and (progn 
             (princ "\nSelect Text ....") 
             (setq ss (ssget '((0 . "text")))) 
           ) 
           (progn 
             (princ "\nPick Curve...") 
             (setq e (ssget "+.:S" '((0 . "*line,arc,circle,ellipse")))) 
           ) 
      ) 
    (progn 
      (setq el         (ssnamex e 0) 
            elst (mapcar '(lambda (x) 
                            (cons (car (xdrx_entity_getstretchpoint x)) 
                                  (cons x (xdrx_getpropertyvalue x "height" "rotation")) 
                            ) 
                          ) 
                         (xdrx_pickset->ents ss) 
                 ) 
            p2         (polar '(0 0 0) (last (car elst)) 1.0) 
            elst (mapcar 'cdr 
                         (vl-sort (mapcar '(lambda (x) 
                                             (cons (car (trans (car x) 0 p2)) 
                                                   x 
                                             ) 
                                           ) 
                                          elst 
                                  ) 
                                  '(lambda (x1 x2) (< (car x1) (car x2))) 
                         ) 
                 ) 
            cv         (cadar el) 
            pt         (xdrx_curve_getclosestpoint cv (last (last (car el)))) 
            pam         (xdrx_curve_getparamatpoint cv pt) 
            fvx         (xdrx_curve_getfirstderiv cv pam) 
            fvy         (xdrx_vector_perpvector fvx) 
            fvz         (xdrx_vector_crossproduct fvx fvy) 
            ang         (angle '(0 0 0) fvy) 
      ) 
      (foreach x elst 
        (setq p          (car x) 
              p1  (polar p (last x) 1.0) 
              ux  (mapcar '- p1 p) 
              uy  (xdrx_vector_perpvector ux) 
              uz  (xdrx_vector_crossproduct ux uy) 
              h          (caddr x) 
              e          (cadr x) 
              mat (xdrx_matrix_aligncoordsystem 
                    (list p ux uy uz) 
                    (list pt fvx fvy fvz) 
                  ) 
        ) 
        (xdrx_entity_transform e mat) 
        (setq pt (polar pt ang (* 1.5 h))) 
      ) 
    ) 
  ) 
  (princ) 
)

iLisp · 发表于 2016-4-15 13:05:11

好像LEE有过一个动态沿线写字，抽空完善了发布为插件

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

[编程申请] 能否写一个多字随线平齐的插件？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

浏览过的版块