QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
9天前
查看: 8943|回复: 8
收起左侧

[已答复] vba里怎么获取上一个创建对象的坐标啊?

[复制链接]
发表于 2012-4-3 19:49:29 | 显示全部楼层 |阅读模式 来自: 中国广东珠海

马上注册,结识高手,享用更多资源,轻松玩转三维网社区。

您需要 登录 才可以下载或查看,没有帐号?注册

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。
+ _' L: R! E$ t' j' u; \' D4 l其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:" m& e# }0 q$ `
1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?
0 U" N& W0 Y: c* U# P8 s2 H2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?5 g+ ~/ i3 Q. P8 E- `
之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了2 h# b0 `8 a' K0 b0 O6 N& R
版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
2012-4-3 19-29-23.jpg

块自动插入.dwg

42.84 KB, 下载次数: 9

InsertBlock.rar

7.03 KB, 下载次数: 6

发表于 2012-4-4 08:29:21 | 显示全部楼层 来自: 中国辽宁
方法一:按照楼主的思路使用选择集
  1. Private Sub cmdInsert_Click()
    0 ~$ y! L) w; I" A& U" ^5 x
  2. Dim ptInsert(2) As Double
    + s/ ]- W* H! w
  3. Dim lastSel As AcadSelectionSet
    . q) b8 z' T( m0 L4 z& }1 ~; y
  4. Dim lastBlock As Variant; Q2 N' w1 W) A" v8 @. j4 |
  5. ptInsert(0) = 00 _. w9 w% ^7 a
  6. ptInsert(1) = 0
    5 C6 l  n* s* `- F8 J) @
  7. ptInsert(2) = 0' R, z" }8 V% ?0 z
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0& j, U0 b6 j2 ^4 R, j
  9. + G5 k! j* R# D7 j$ C( \
  10. . l- G/ ~$ l* x, F) r2 i
  11. ; ?$ e2 ^' T2 E' t! N+ N
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    & [" s) S& E2 b7 e, z6 ~# j
  13. lastSel.Select acSelectionSetLast
    3 D% H4 b7 n; j" F4 p" k

  14. # p9 j6 O0 m; n) n" o% ?
  15. Dim B As AcadBlockReference '声明一个块参照变量) k- i8 a, J9 ^) G' N' B7 l, P% L6 S
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标( X1 L- R, J" b* W$ P" h( o5 T5 q
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量2 f% V& P3 F1 @# P4 Y) a
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组6 y7 l' @, A- A7 H, s" o

  19.   }7 _7 h1 s6 o! k* m
  20. lastSel.Delete '删除选择集
    ' o: O5 [" r# J" c
  21. * X" y; q2 e9 b% z" k' t6 B  ^/ V* a

  22. & f5 ]- i4 z% p
  23. ThisDrawing.Regen acActiveViewport
    & m& f2 T( F) B0 F: _8 M
  24. 0 t  h+ |' V4 i4 s" ?5 D

  25. 1 N- o, {3 w; y5 w: X7 e# p
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click()
    ; _4 {6 M7 `9 m8 R% z7 g# U
  2. Dim ptInsert(2) As Double/ k: b; s% y8 H3 u1 K1 o& H
  3. 'Dim lastSel As AcadSelectionSet
    # e* b& D2 w* e8 i; \
  4. Dim lastBlock As Variant  C) q9 ~% h5 x
  5. ptInsert(0) = 0- ?6 h+ K, x; [
  6. ptInsert(1) = 06 C* ]* d% ~0 A! G  W1 m
  7. ptInsert(2) = 0
    # M  g  T, N+ q' z/ o8 ^2 f

  8. 9 z  |: E( ^# P# a" }" A

  9. ) ?* c0 D7 Q  ?
  10. ) B7 O& w) s! r5 b/ e4 S9 B- [, O
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '2 p* `1 r! w! \' T* ]' p/ c
  12. 'lastSel.Select acSelectionSetLast1 y4 G$ s. ?( |, F/ f# }
  13. ' Y8 X; G' P5 z+ u, R
  14. Dim B As AcadBlockReference '声明一个块参照变量
    3 @  Y- z# w$ E3 @: d
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    ) T2 U8 M9 e  U6 z/ K
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)- p8 y. H' N2 M+ J" {
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组* ]; U; X0 r  J2 Z7 C

  18. + p& {; m; K- b& Z' V# w7 Y
  19. 'lastSel.Delete '删除选择集
    ' h* P/ d; `: d+ `: |  f

  20. . H$ F+ ~$ ]/ S  B* j

  21. ) R* P; N: n6 Y8 D; q1 j5 t
  22. ThisDrawing.Regen acActiveViewport
    - A% S% b; [( t8 n7 J. Y+ A

  23. ! c5 m! O9 e& v% _' V6 Z5 E; o! v
  24. 1 E* y9 M+ d! q; B, b% w* Q& X: N. u
  25. End Sub
复制代码

评分

参与人数 1三维币 +10 收起 理由
唐昕晨 + 10 应用

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑 9 D3 c2 n% E1 R

' u- }! @2 w: u' \% k& @/ _首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:7 P2 F# i7 Y8 e; `9 C! R. B
  1. pNew(0) = P(0) - 500
    + _; O$ m3 t5 g  n
  2. pNew(1) = P(1) + 1405.84 K1 X' T, I9 P/ Z2 V% R
  3. pNew(2) = P(2)
复制代码
7 [, t/ u/ \3 _
我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?& e' k9 C: p: l' d9 }
就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。
. c3 T0 k& ~* N0 N" C1 P2 Q谢谢版主
  O+ u3 q5 g6 y4 Z+ T
% R1 V: n3 C) m- i+ f  P
7 ]- w- A/ R. i. ~
  1. Private Sub cmdInsert_Click()
    ! p9 M6 l  s) V6 q( j" j/ J
  2. Dim ptInsert(2) As Double% ~1 H+ z* n+ Z0 q! g: E! r1 ~0 o
  3. Dim lastBlock As Variant
    0 Q: t+ I, ?4 c- A* D
  4. ptInsert(0) = 0" v/ t. a/ J8 @) [
  5. ptInsert(1) = 0) d* K; a7 [+ }, r" {  l, ]
  6. ptInsert(2) = 0
    ! N) I5 p" \" p/ {( w" `

  7. 2 w$ [" j: G7 T
  8. '----------插入块A 仅仅一个---------------------------------0 i% n( B  P/ A0 }6 _) @
  9. Dim B As AcadBlockReference '声明一个块参照变量. S; c0 i  ?- T5 F2 n; i2 q1 c* Y# k
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    5 \) ^3 _! n3 h& K# o  h
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)% h# p; c) Y: ^% O: ?% C
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组+ I5 u+ }* U' T* G
  13. '----------插入块A 完成---------------------------------; X( V  N  y$ B
  14. 0 O5 P9 I! i. e5 G1 t- _0 j) t# ~4 E
  15. '----------插入块B---------------------------------2 t$ Y- M  _/ y( [* ~# y; r. R$ K) K
  16. '第一个块,需要单独插入+ x$ R% ?" q0 c7 C+ F, T
  17. Dim pNew(2) As Double( k* e& h) H9 L
  18. pNew(0) = P(0) - 500
    0 u; J7 j' |3 A' \4 _: ^
  19. pNew(1) = P(1) + 1405.8* {. ~' C3 y3 a! V1 a7 g) j0 O0 E
  20. pNew(2) = P(2)2 x: R0 m/ Y8 \
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)! x* j/ O3 ~% [: j
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    + {* Y( {$ m/ ~8 [
  23. ThisDrawing.Regen acActiveViewport: q5 }# a  \* _
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑 4 u( ]) f6 ^$ J1 ~' b" L) c
: M0 m1 ~) U9 Z( t
3# tataki : t* [, I7 S4 s) w
看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 / p8 a+ w- u- ]2 l. I* Z4 I
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角8 I9 V! q6 {. s9 l
  2. Dim MaxPoint As Variant'右上角
    . H% M4 ]6 Y7 j; M+ v. h: K
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!6 g; N# j6 o! i! v/ l
原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
+ Q7 Z' D- s3 [哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。6 V  u6 J3 C2 }" P, l0 |

/ @& [' i  z8 ~2 @1 a' p5 H2 E另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
( m6 P. S  b; \5 u- F哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...
% G7 I; a1 J3 L* m$ x6 g" ]tataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif
7 `) p7 A/ _5 }6 _
lisp一头雾水还能设置捕捉,牛啊!说得大家一头雾水~~
发表于 2013-2-21 23:23:43 | 显示全部楼层 来自: 中国广东东莞
谢谢楼主分享
发表于 2019-6-27 09:08:48 | 显示全部楼层 来自: 中国山东潍坊
版主辛苦,特登录赞一下
发表于 2021-1-21 07:32:00 | 显示全部楼层 来自: 中国广西贺州
学习大神们的经验
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

快速回复 返回顶部 返回列表