反应器实例-Pline长宽文字

iLisp · 发表于 2016-12-12 17:35:13

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

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

×

(defun !last (lst)
(reverse (cdr (reverse lst)))
)
(defun make-same-pline-txt (obj1 obj2)
(defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)
(setq txt (vlax-ldata-get v1 "Link"))
(if (not (vlax-erased-p txt))
(progn
(setq p1 (vlax-curve-getpointatparam v1 0.)
p2 (vlax-curve-getpointatparam v1 1.)
p3 (vlax-curve-getpointatparam v1 2.)
w (fix (distance p1 p2))
h (fix (distance p2 p3))
)
(vl-catch-all-apply
'vla-put-textstring
(list txt
(strcat (itoa w) "X" (itoa h))
)
)
)
)
)
(defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)
(setq pl (vlax-ldata-get v1 "Link"))
(if (not (vlax-erased-p pl))
(progn
(setq sp (vlax-curve-getstartpoint pl)
p1 (vlax-curve-getpointatparam pl 1.)
p2 (vlax-curve-getpointatparam pl 2.)
p3 (vlax-curve-getpointatparam pl 3.)
str (vla-get-textstring v1)
pos (vl-string-position (ascii "X") str)
w (distof (substr str 1 pos))
h (distof (substr str (+ pos 2)))
)
(vla-put-coordinates
pl
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 7))
(apply 'append
(list (!last sp)
(setq p11 (polar (!last sp) (angle sp p1) w))
(setq p22 (polar p11 (angle p1 p2) h))
(polar p22 (angle p2 p3) w)
)
)
)
)
)
(vla-put-closed pl actrue)
)
)
)
(if (and
obj2
(vlax-write-enabled-p obj2)
(vlax-read-enabled-p obj1)
)
(if (= (vla-get-objectname obj1) "AcDbText")
(chg_txt_link_pline obj1)
(chg_pline_link_txt obj1)
)
)
)
(defun make-same-pline-txt-reaction (notifier reactor arg-list)
(make-same-pline-txt notifier (VLR-Data reactor))
)
(defun c:tt (/ e1 e2 obj1 obj2)
(if (and (setq e1 (car (entsel "\nPick Pline: ")))
(setq e2 (car (entsel "\nSelect associated text: ")))
)
(progn
(vlax-ldata-put
e1
"Link"
(setq obj2 (vlax-ename->vla-object e2))
)
(vlax-ldata-put
e2
"Link"
(setq obj1 (vlax-ename->vla-object e1))
)
(setq myReactor
(vlr-object-reactor
(list obj2)
obj1
'((:vlr-modified . make-same-pline-txt-reaction))
)
)
(setq TxtReactor
(vlr-object-reactor
(list obj1)
obj2
'((:vlr-modified . make-same-pline-txt-reaction))
)
)
)
)
(princ)
)

(defun !last (lst) 
  (reverse (cdr (reverse lst))) 
) 
(defun make-same-pline-txt (obj1 obj2) 
  (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt) 
    (setq txt (vlax-ldata-get v1 "Link")) 
    (if        (not (vlax-erased-p txt)) 
      (progn 
        (setq p1 (vlax-curve-getpointatparam v1 0.) 
              p2 (vlax-curve-getpointatparam v1 1.) 
              p3 (vlax-curve-getpointatparam v1 2.) 
              w         (fix (distance p1 p2)) 
              h         (fix (distance p2 p3)) 
        ) 
        (vl-catch-all-apply 
          'vla-put-textstring 
          (list        txt 
                (strcat (itoa w) "X" (itoa h)) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts) 
    (setq pl (vlax-ldata-get v1 "Link")) 
    (if        (not (vlax-erased-p pl)) 
      (progn 
        (setq sp  (vlax-curve-getstartpoint pl) 
              p1  (vlax-curve-getpointatparam pl 1.) 
              p2  (vlax-curve-getpointatparam pl 2.) 
              p3  (vlax-curve-getpointatparam pl 3.) 
              str (vla-get-textstring v1) 
              pos (vl-string-position (ascii "X") str) 
              w          (distof (substr str 1 pos)) 
              h          (distof (substr str (+ pos 2))) 
        ) 
        (vla-put-coordinates 
          pl 
          (vlax-make-variant 
            (vlax-safearray-fill 
              (vlax-make-safearray vlax-vbDouble '(0 . 7)) 
              (apply 'append 
                     (list (!last sp) 
                           (setq p11 (polar (!last sp) (angle sp p1) w)) 
                           (setq p22 (polar p11 (angle p1 p2) h)) 
                           (polar p22 (angle p2 p3) w) 
                     ) 
              ) 
            ) 
          ) 
        ) 
        (vla-put-closed pl actrue) 
      ) 
    ) 
  ) 
  (if (and 
        obj2 
        (vlax-write-enabled-p obj2) 
        (vlax-read-enabled-p obj1) 
      ) 
    (if        (= (vla-get-objectname obj1) "AcDbText") 
      (chg_txt_link_pline obj1) 
      (chg_pline_link_txt obj1) 
    ) 
  ) 
) 
(defun make-same-pline-txt-reaction (notifier reactor arg-list) 
  (make-same-pline-txt notifier (VLR-Data reactor)) 
) 
(defun c:tt (/ e1 e2 obj1 obj2) 
  (if (and (setq e1 (car (entsel "\nPick Pline: "))) 
           (setq e2 (car (entsel "\nSelect associated text: "))) 
      ) 
    (progn 
      (vlax-ldata-put 
        e1 
        "Link" 
        (setq obj2 (vlax-ename->vla-object e2)) 
      ) 
      (vlax-ldata-put 
        e2 
        "Link" 
        (setq obj1 (vlax-ename->vla-object e1)) 
      ) 
      (setq myReactor 
             (vlr-object-reactor 
               (list obj2) 
               obj1 
               '((:vlr-modified . make-same-pline-txt-reaction)) 
             ) 
      ) 
      (setq TxtReactor 
             (vlr-object-reactor 
               (list obj1) 
               obj2 
               '((:vlr-modified . make-same-pline-txt-reaction)) 
             ) 
      ) 
    ) 
  ) 
  (princ) 
)

Lisphk · 发表于 2016-12-12 17:47:50

执行TT后，选择文字后，没有把文字变成长X宽，只有编辑下矩形，文字才跟着变化。

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

[他山之石] 反应器实例-Pline长宽文字

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

相关帖子