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

cable2004

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

st788796

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

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

2. 
   
3. (defun c:tt (/ pt_trans ss draw doc ms blks p por e sl origin)
   
4.   (defun pt_trans (p bp x y z an / an1)
   
5.     (setq an1 (+ an (angle por p))
   
6.           p   (mapcar '* p (list x y z))
   
7.           p   (polar por an1 (distance por p))
   
8.           p   (mapcar '+ bp p)
   
9.     )
   
10.   )
    
11.   (defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
    
12.     (setq name         (vla-get-name blk)
    
13.           blkdef (vla-item blks name)
    
14.           an         (vla-get-rotation blk)
    
15.           xc         (vlax-get blk 'xscalefactor)
    
16.           yc         (vlax-get blk 'yscalefactor)
    
17.           zc         (vlax-get blk 'zscalefactor)
    
18.           bp         (vlax-get blk 'insertionpoint)
    
19.           origin (vlax-get blkdef 'origin)
    
20.           por         '(0 0 0)
    
21.     )
    
22.     (vlax-for obj blkdef
    
23.       (if (= (vla-get-objectname obj) "AcDbText")
    
24.         (progn
    
25.           (setq p (vlax-get obj 'insertionpoint))
    
26. 
    
27.           (vla-put-color
    
28.             (vla-addcircle
    
29.               ms
    
30.               (vlax-3d-point
    
31.                 (pt_trans (mapcar '- p (vlax-get blkdef 'origin))
    
32.                           bp
    
33.                           xc
    
34.                           yc
    
35.                           zc
    
36.                           an
    
37.                 )
    
38.               )
    
39.               10.0
    
40.             )
    
41.             2
    
42.           )
    
43.         )
    
44.       )
    
45.       (if (= (vla-get-objectname obj) "AcDbPolyline")
    
46.         (vla-put-color
    
47.           (vla-addcircle
    
48.             ms
    
49.             (vlax-3d-point
    
50.               (pt_trans        (mapcar        '-
    
51.                                 (vlax-curve-getstartpoint obj)
    
52.                                 (vlax-get blkdef 'origin)
    
53.                         )
    
54.                         bp
    
55.                         xc
    
56.                         yc
    
57.                         zc
    
58.                         an
    
59.               )
    
60.             )
    
61.             20.0
    
62.           )
    
63.           1
    
64.         )
    
65.       )
    
66.     )
    
67.   )
    
68.   (vl-load-com)
    
69.   (setq        doc  (vla-get-activedocument (vlax-get-acad-object))
    
70.         blks (vla-get-blocks doc)
    
71.         ms   (vla-get-modelspace doc)
    
72.   )
    
73.   (if (setq ss (ssget '((0 . "insert"))))
    
74.     (progn
    
75.       (setq sl (sslength ss))
    
76.       (while (setq e (ssname ss (setq sl (1- sl))))
    
77.         (draw blks (vlax-ename->vla-object e))
    
78.       )
    
79.     )
    
80.   )
    
81.   (princ)
    
82. )

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

newer

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

cable2004

已经修改！

st788796

也可以用矩阵转换

2. 
   
3. (defun c:tt (/ ss draw doc ms blks)
   
4.   (defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
   
5.     (setq name         (vla-get-name blk)
   
6.           blkdef (vla-item blks name)
   
7.           an         (vla-get-rotation blk)
   
8.           xc         (vlax-get blk 'xscalefactor)
   
9.           yc         (vlax-get blk 'yscalefactor)
   
10.           zc         (vlax-get blk 'zscalefactor)
    
11.           bp         (vlax-get blk 'insertionpoint)
    
12.           por         '(0 0 0)
    
13.     )
    
14.     (vlax-for obj blkdef
    
15.       (if (= (vla-get-objectname obj) "AcDbText")
    
16.         (progn
    
17.           (setq        p   (vlax-get obj 'insertionpoint)
    
18.                 an1 (+ an (angle por p))
    
19.                 p   (mapcar '* p (list xc yc zc))
    
20.                 p   (polar por an1 (distance por p))
    
21.                 p   (mapcar '+ bp p)
    
22.           )
    
23.           (vla-put-color
    
24.             (vla-addcircle ms (vlax-3d-point p) 10.0)
    
25.             1
    
26.           )
    
27.         )
    
28.       )
    
29.     )
    
30.   )
    
31.   (vl-load-com)
    
32.   (setq        doc  (vla-get-activedocument (vlax-get-acad-object))
    
33.         blks (vla-get-blocks doc)
    
34.         ms   (vla-get-modelspace doc)
    
35.   )
    
36.   (if (setq ss (ssget '((0 . "insert"))))
    
37.     (progn
    
38.       (setq sl (sslength ss))
    
39.       (while (setq e (ssname ss (setq sl (1- sl))))
    
40.         (draw blks (vlax-ename->vla-object e))
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )

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

st788796

加上线的

2. 
   
3. (defun c:tt (/ pt_trans ss draw doc ms blks)
   
4.   (defun pt_trans (p bp x y z an / an1)
   
5.     (setq an1 (+ an (angle por p))
   
6.           p   (mapcar '* p (list x y z))
   
7.           p   (polar por an1 (distance por p))
   
8.           p   (mapcar '+ bp p)
   
9.     )
   
10.   )
    
11.   (defun draw (blks blk / blkdef name an xc yc zc bp p por an1)
    
12.     (setq name         (vla-get-name blk)
    
13.           blkdef (vla-item blks name)
    
14.           an         (vla-get-rotation blk)
    
15.           xc         (vlax-get blk 'xscalefactor)
    
16.           yc         (vlax-get blk 'yscalefactor)
    
17.           zc         (vlax-get blk 'zscalefactor)
    
18.           bp         (vlax-get blk 'insertionpoint)
    
19.           por         '(0 0 0)
    
20.     )
    
21.     (vlax-for obj blkdef
    
22.       (if (= (vla-get-objectname obj) "AcDbText")
    
23.         (progn
    
24.           (setq p (vlax-get obj 'insertionpoint))
    
25.           (vla-put-color
    
26.             (vla-addcircle
    
27.               ms
    
28.               (vlax-3d-point (pt_trans p bp xc yc zc an))
    
29.               10.0
    
30.             )
    
31.             2
    
32.           )
    
33.         )
    
34.       )
    
35.       (if (= (vla-get-objectname obj) "AcDbPolyline")
    
36.         (vla-put-color
    
37.           (vla-addcircle
    
38.             ms
    
39.             (vlax-3d-point
    
40.               (pt_trans (vlax-curve-getstartpoint obj) bp xc yc zc an)
    
41.             )
    
42.             20.0
    
43.           )
    
44.           1
    
45.         )
    
46.       )
    
47.     )
    
48.   )
    
49.   (vl-load-com)
    
50.   (setq        doc  (vla-get-activedocument (vlax-get-acad-object))
    
51.         blks (vla-get-blocks doc)
    
52.         ms   (vla-get-modelspace doc)
    
53.   )
    
54.   (if (setq ss (ssget '((0 . "insert"))))
    
55.     (progn
    
56.       (setq sl (sslength ss))
    
57.       (while (setq e (ssname ss (setq sl (1- sl))))
    
58.         (draw blks (vlax-ename->vla-object e))
    
59.       )
    
60.     )
    
61.   )
    
62.   (princ)
    
63. )

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

cable2004

谢谢 st788796
谢谢 newer

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

marting

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

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

cable2004

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