【动态】文字沿着曲线游走

Lispboy · 发表于 2018-12-22 00:46:18

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

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

×

(defun c:tt ()
(defun _callback (dynpt)
(setq p1 (mapcar '+ dynpt '(0 1 0))
ints (xdrx_get_inters (list p1 dynpt) e 1)
)
(if ints
(progn (setq ints (car ints)
dist (xdrx_curve_getdistatpoint e ints)
)
(xdrx_getpropertyvalue e "length")
(setq last-dist (+ dist (cadr (last lst2))))
(if (< last-dist #length)
(progn (foreach n lst2
(setq e1 (car n)
dist1 (+ dist (cadr n))
offset (caddr n)
p2 (xdrx_curve_getpointatdist e dist1)
v1 (xdrx_curve_getfirstderiv e p2)
p2 (mapcar '+
p2
(xdrx_vector_product
(xdrx_vector_perpvector v1)
offset
)
)
)
(xdrx_setpropertyvalue
e1
"alignmentpoint"
p2
"rotation"
(xdrx_vector_angle v1)
)
)
)
)
)
)
)
(if (and (xdrx_initssget "\n选择文字<退出>:")
(setq ss (xdrx_ssget '((0 . "text"))))
(setq e (car (xdrx_entsel
"\n选择曲线<退出>:"
'((0 . "*line,arc,circle,ellipse"))
)
)
)
)
(progn (xdrx_begin)
(setq lst (mapcar
'(lambda (x)
(list (xdrx_getpropertyvalue x "alignmentpoint") x)
)
(xdrx_pickset->ents ss)
)
lst1 (mapcar 'car lst)
lst1 (xdrx_points_sortoncurve e lst1)
lst1 (mapcar '(lambda (x) (list (cadr x) (apply 'distance x)))
lst1
)
lst2 (mapcar
'(lambda (x)
(list (last (xd::list:assoc-fuzz (car x) lst 1e-3))
(xdrx_curve_getdistatpoint e (car x))
(last x)
)
)
lst1
)
dist (cadr (car lst2))
lst2 (mapcar
'(lambda (x) (list (car x) (- (cadr x) dist) (last x)))
lst2
)
)
(xdrx_pointmonitor "_callback")
(getpoint)
(xdrx_pointmonitor)
(xdrx_end)
)
)
)

(defun c:tt () 
  (defun _callback (dynpt) 
    (setq p1   (mapcar '+ dynpt '(0 1 0)) 
          ints (xdrx_get_inters (list p1 dynpt) e 1) 
           
    ) 
    (if        ints 
      (progn (setq ints        (car ints) 
                   dist        (xdrx_curve_getdistatpoint e ints) 
             ) 
             (xdrx_getpropertyvalue e "length") 
             (setq last-dist (+ dist (cadr (last lst2)))) 
             (if (< last-dist #length) 
               (progn (foreach n lst2 
                        (setq e1     (car n) 
                              dist1  (+ dist (cadr n)) 
                              offset (caddr n) 
                              p2     (xdrx_curve_getpointatdist e dist1) 
                              v1     (xdrx_curve_getfirstderiv e p2) 
                              p2     (mapcar '+ 
                                             p2 
                                             (xdrx_vector_product 
                                               (xdrx_vector_perpvector v1) 
                                               offset 
                                             ) 
                                     ) 
                        ) 
                        (xdrx_setpropertyvalue 
                          e1 
                          "alignmentpoint" 
                          p2 
                          "rotation" 
                          (xdrx_vector_angle v1) 
                        ) 
                      ) 
               ) 
             ) 
      ) 
    ) 
  ) 
  (if (and (xdrx_initssget "\n选择文字<退出>:") 
           (setq ss (xdrx_ssget '((0 . "text")))) 
           (setq e (car        (xdrx_entsel 
                          "\n选择曲线<退出>:" 
                          '((0 . "*line,arc,circle,ellipse")) 
                        ) 
                   ) 
           ) 
      ) 
    (progn (xdrx_begin) 
           (setq lst  (mapcar 
                        '(lambda (x) 
                           (list (xdrx_getpropertyvalue x "alignmentpoint") x) 
                         ) 
                        (xdrx_pickset->ents ss) 
                      ) 
                 lst1 (mapcar 'car lst) 
                 lst1 (xdrx_points_sortoncurve e lst1) 
                 lst1 (mapcar '(lambda (x) (list (cadr x) (apply 'distance x))) 
                              lst1 
                      ) 
                 lst2 (mapcar 
                        '(lambda (x) 
                           (list (last (xd::list:assoc-fuzz (car x) lst 1e-3)) 
                                 (xdrx_curve_getdistatpoint e (car x)) 
                                 (last x) 
                           ) 
                         ) 
                        lst1 
                      ) 
                 dist (cadr (car lst2)) 
                 lst2 (mapcar 
                        '(lambda (x) (list (car x) (- (cadr x) dist) (last x))) 
                        lst2 
                      ) 
           ) 
           (xdrx_pointmonitor "_callback") 
           (getpoint) 
           (xdrx_pointmonitor) 
           (xdrx_end) 
    ) 
  ) 
)

liuyj · 发表于 2018-12-22 09:01:17

牛大发了，就是这个效果

yangjian001 · 发表于 2018-12-22 09:07:35

做一个热心并受欢迎的人

csy0415 · 发表于 2018-12-23 14:26:15

厉害，向大师学习！

m梦想家 · 发表于 2019-1-14 19:42:51

楼主厉害了

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

[教学] 【动态】文字沿着曲线游走

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

浏览过的版块