求图块里面文字的插入点和图块里面ly线的起点。

cable2004 · 发表于 2017-4-20 23:25:33

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

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

×

本帖最后由 cable2004 于 2017-4-21 00:09 编辑

求图块里面文字的插入点和图块里面ly线的起点。

st788796 · 发表于 2017-4-21 11:52:32

cable2004 发表于 2017-4-21 11:09

这个块有 Origin，和 WCS 原点不重合

(defun c:tt (/ pt_trans ss draw doc ms blks p por e sl origin)
(defun pt_trans (p bp x y z an / an1)
(setq an1 (+ an (angle por p))
p (mapcar '* p (list x y z))
p (polar por an1 (distance por p))
p (mapcar '+ bp p)
)
)
(defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
(setq name (vla-get-name blk)
blkdef (vla-item blks name)
an (vla-get-rotation blk)
xc (vlax-get blk 'xscalefactor)
yc (vlax-get blk 'yscalefactor)
zc (vlax-get blk 'zscalefactor)
bp (vlax-get blk 'insertionpoint)
origin (vlax-get blkdef 'origin)
por '(0 0 0)
)
(vlax-for obj blkdef
(if (= (vla-get-objectname obj) "AcDbText")
(progn
(setq p (vlax-get obj 'insertionpoint))
(vla-put-color
(vla-addcircle
ms
(vlax-3d-point
(pt_trans (mapcar '- p (vlax-get blkdef 'origin))
bp
xc
yc
zc
an
)
)
10.0
)
2
)
)
)
(if (= (vla-get-objectname obj) "AcDbPolyline")
(vla-put-color
(vla-addcircle
ms
(vlax-3d-point
(pt_trans (mapcar '-
(vlax-curve-getstartpoint obj)
(vlax-get blkdef 'origin)
)
bp
xc
yc
zc
an
)
)
20.0
)
1
)
)
)
)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blks (vla-get-blocks doc)
ms (vla-get-modelspace doc)
)
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(draw blks (vlax-ename->vla-object e))
)
)
)
(princ)
)

(defun c:tt (/ pt_trans ss draw doc ms blks p por e sl origin) 
  (defun pt_trans (p bp x y z an / an1) 
    (setq an1 (+ an (angle por p)) 
          p   (mapcar '* p (list x y z)) 
          p   (polar por an1 (distance por p)) 
          p   (mapcar '+ bp p) 
    ) 
  ) 
  (defun draw (blks blk / blkdef name an xc yc zc bp p por an1) 
    (setq name         (vla-get-name blk) 
          blkdef (vla-item blks name) 
          an         (vla-get-rotation blk) 
          xc         (vlax-get blk 'xscalefactor) 
          yc         (vlax-get blk 'yscalefactor) 
          zc         (vlax-get blk 'zscalefactor) 
          bp         (vlax-get blk 'insertionpoint) 
          origin (vlax-get blkdef 'origin) 
          por         '(0 0 0) 
    ) 
    (vlax-for obj blkdef 
      (if (= (vla-get-objectname obj) "AcDbText") 
        (progn 
          (setq p (vlax-get obj 'insertionpoint)) 
 
          (vla-put-color 
            (vla-addcircle 
              ms 
              (vlax-3d-point 
                (pt_trans (mapcar '- p (vlax-get blkdef 'origin)) 
                          bp 
                          xc 
                          yc 
                          zc 
                          an 
                ) 
              ) 
              10.0 
            ) 
            2 
          ) 
        ) 
      ) 
      (if (= (vla-get-objectname obj) "AcDbPolyline") 
        (vla-put-color 
          (vla-addcircle 
            ms 
            (vlax-3d-point 
              (pt_trans        (mapcar        '- 
                                (vlax-curve-getstartpoint obj) 
                                (vlax-get blkdef 'origin) 
                        ) 
                        bp 
                        xc 
                        yc 
                        zc 
                        an 
              ) 
            ) 
            20.0 
          ) 
          1 
        ) 
      ) 
    ) 
  ) 
  (vl-load-com) 
  (setq        doc  (vla-get-activedocument (vlax-get-acad-object)) 
        blks (vla-get-blocks doc) 
        ms   (vla-get-modelspace doc) 
  ) 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (draw blks (vlax-ename->vla-object e)) 
      ) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2017-4-20 23:29:45

换低版本保存，更新压缩文件，并截取个图片贴上来，方便讨论。

cable2004 · 发表于 2017-4-21 07:49:53

已经修改！

st788796 · 发表于 2017-4-21 08:53:45

也可以用矩阵转换

(defun c:tt (/ ss draw doc ms blks)
(defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
(setq name (vla-get-name blk)
blkdef (vla-item blks name)
an (vla-get-rotation blk)
xc (vlax-get blk 'xscalefactor)
yc (vlax-get blk 'yscalefactor)
zc (vlax-get blk 'zscalefactor)
bp (vlax-get blk 'insertionpoint)
por '(0 0 0)
)
(vlax-for obj blkdef
(if (= (vla-get-objectname obj) "AcDbText")
(progn
(setq p (vlax-get obj 'insertionpoint)
an1 (+ an (angle por p))
p (mapcar '* p (list xc yc zc))
p (polar por an1 (distance por p))
p (mapcar '+ bp p)
)
(vla-put-color
(vla-addcircle ms (vlax-3d-point p) 10.0)
1
)
)
)
)
)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blks (vla-get-blocks doc)
ms (vla-get-modelspace doc)
)
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(draw blks (vlax-ename->vla-object e))
)
)
)
(princ)
)

(defun c:tt (/ ss draw doc ms blks) 
  (defun draw (blks blk / blkdef name an xc yc zc bp p por an1) 
    (setq name         (vla-get-name blk) 
          blkdef (vla-item blks name) 
          an         (vla-get-rotation blk) 
          xc         (vlax-get blk 'xscalefactor) 
          yc         (vlax-get blk 'yscalefactor) 
          zc         (vlax-get blk 'zscalefactor) 
          bp         (vlax-get blk 'insertionpoint) 
          por         '(0 0 0) 
    ) 
    (vlax-for obj blkdef 
      (if (= (vla-get-objectname obj) "AcDbText") 
        (progn 
          (setq        p   (vlax-get obj 'insertionpoint) 
                an1 (+ an (angle por p)) 
                p   (mapcar '* p (list xc yc zc)) 
                p   (polar por an1 (distance por p)) 
                p   (mapcar '+ bp p) 
          ) 
          (vla-put-color 
            (vla-addcircle ms (vlax-3d-point p) 10.0) 
            1 
          ) 
        ) 
      ) 
    ) 
  ) 
  (vl-load-com) 
  (setq        doc  (vla-get-activedocument (vlax-get-acad-object)) 
        blks (vla-get-blocks doc) 
        ms   (vla-get-modelspace doc) 
  ) 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (draw blks (vlax-ename->vla-object e)) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2017-4-21 09:09:22

加上线的

(defun c:tt (/ pt_trans ss draw doc ms blks)
(defun pt_trans (p bp x y z an / an1)
(setq an1 (+ an (angle por p))
p (mapcar '* p (list x y z))
p (polar por an1 (distance por p))
p (mapcar '+ bp p)
)
)
(defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
(setq name (vla-get-name blk)
blkdef (vla-item blks name)
an (vla-get-rotation blk)
xc (vlax-get blk 'xscalefactor)
yc (vlax-get blk 'yscalefactor)
zc (vlax-get blk 'zscalefactor)
bp (vlax-get blk 'insertionpoint)
por '(0 0 0)
)
(vlax-for obj blkdef
(if (= (vla-get-objectname obj) "AcDbText")
(progn
(setq p (vlax-get obj 'insertionpoint))
(vla-put-color
(vla-addcircle
ms
(vlax-3d-point (pt_trans p bp xc yc zc an))
10.0
)
2
)
)
)
(if (= (vla-get-objectname obj) "AcDbPolyline")
(vla-put-color
(vla-addcircle
ms
(vlax-3d-point
(pt_trans (vlax-curve-getstartpoint obj) bp xc yc zc an)
)
20.0
)
1
)
)
)
)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blks (vla-get-blocks doc)
ms (vla-get-modelspace doc)
)
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(draw blks (vlax-ename->vla-object e))
)
)
)
(princ)
)

(defun c:tt (/ pt_trans ss draw doc ms blks) 
  (defun pt_trans (p bp x y z an / an1) 
    (setq an1 (+ an (angle por p)) 
          p   (mapcar '* p (list x y z)) 
          p   (polar por an1 (distance por p)) 
          p   (mapcar '+ bp p) 
    ) 
  ) 
  (defun draw (blks blk / blkdef name an xc yc zc bp p por an1) 
    (setq name         (vla-get-name blk) 
          blkdef (vla-item blks name) 
          an         (vla-get-rotation blk) 
          xc         (vlax-get blk 'xscalefactor) 
          yc         (vlax-get blk 'yscalefactor) 
          zc         (vlax-get blk 'zscalefactor) 
          bp         (vlax-get blk 'insertionpoint) 
          por         '(0 0 0) 
    ) 
    (vlax-for obj blkdef 
      (if (= (vla-get-objectname obj) "AcDbText") 
        (progn 
          (setq p (vlax-get obj 'insertionpoint)) 
          (vla-put-color 
            (vla-addcircle 
              ms 
              (vlax-3d-point (pt_trans p bp xc yc zc an)) 
              10.0 
            ) 
            2 
          ) 
        ) 
      ) 
      (if (= (vla-get-objectname obj) "AcDbPolyline") 
        (vla-put-color 
          (vla-addcircle 
            ms 
            (vlax-3d-point 
              (pt_trans (vlax-curve-getstartpoint obj) bp xc yc zc an) 
            ) 
            20.0 
          ) 
          1 
        ) 
      ) 
    ) 
  ) 
  (vl-load-com) 
  (setq        doc  (vla-get-activedocument (vlax-get-acad-object)) 
        blks (vla-get-blocks doc) 
        ms   (vla-get-modelspace doc) 
  ) 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (draw blks (vlax-ename->vla-object e)) 
      ) 
    ) 
  ) 
  (princ) 
)

cable2004 · 发表于 2017-4-21 09:39:46

本帖最后由 cable2004 于 2017-4-21 09:45 编辑

谢谢 st788796
谢谢 newer

数学不好，有机会看看矩阵的算法。

marting · 发表于 2017-4-21 11:06:35

cable2004 发表于 2017-4-21 09:39

其实也不用知道算法了，都有现成的函数，直接算就行了。

cable2004 · 发表于 2017-4-21 11:09:21

大师，看看好像换一个就不行了。

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

[求助] 求图块里面文字的插入点和图块里面ly线的起点。

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