QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 8907|回复: 8
收起左侧

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

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

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。/ ]1 Q$ g* L$ v  X
其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:' z+ b2 M: A5 p) L
1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?
4 P& A1 L9 @$ s8 p, f0 C0 ]2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?3 k5 d% G: j, T: x0 K6 p+ ]8 q
之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了
, \+ y% [' g- j+ }- I7 G  U6 P版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()# ?: V1 J3 X+ I) J- w
  2. Dim ptInsert(2) As Double9 q2 y/ G! P; l9 K5 v
  3. Dim lastSel As AcadSelectionSet
    4 f# j. b9 e0 {. f6 P
  4. Dim lastBlock As Variant* n+ F0 w  n7 e/ |1 C% a3 j
  5. ptInsert(0) = 0
    ' y" X! z6 ]! l' q5 q) j
  6. ptInsert(1) = 0- @( |3 J& C, p7 e" I/ j
  7. ptInsert(2) = 0$ |+ L! _$ H5 D* E( `
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0
    & S7 \1 Y3 r; C' `  C

  9. 7 D+ x1 W! f# k1 q6 m& F
  10. - f5 o3 j, M  l/ D! ~) _
  11. * Z  A2 ~3 s& C; a2 K' m; r" S! Y1 ^5 h
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '7 X9 d  g' J# A
  13. lastSel.Select acSelectionSetLast9 d- i( Z' i) ?7 V/ {
  14. " j7 C5 z; z4 t- S) S! J
  15. Dim B As AcadBlockReference '声明一个块参照变量
    9 C5 W. R) Y# J! u2 h- O1 \* g
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标* J& h5 m6 D8 R7 O% Q' b) a7 O
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量
    7 U7 W3 _( s3 t" R/ E5 E9 D& L; k
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    ; a: U$ n# R6 W# Y+ I

  19. & n* R4 L( R, B, U9 [' p
  20. lastSel.Delete '删除选择集
    . O% g! N' `3 F

  21. 9 s7 A' t1 Y9 e4 Z2 _4 e
  22. 7 U& G$ s( {8 t$ i
  23. ThisDrawing.Regen acActiveViewport
    ' n, p9 y, `8 P6 G! N9 M: A

  24. 4 _8 Y. g( S3 R0 E3 w# y

  25. ' I: T+ r% R2 k
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click()
    2 U" U6 X6 l0 W4 N; d" C
  2. Dim ptInsert(2) As Double' {- |/ S% B3 W# Z# }4 Y* N
  3. 'Dim lastSel As AcadSelectionSet6 H+ Y) e1 L! d) @; f5 O
  4. Dim lastBlock As Variant
    ! J. @4 n1 Y2 P" c! V8 Q0 L
  5. ptInsert(0) = 0! A0 V1 J; S$ Y7 V) Z. y
  6. ptInsert(1) = 03 F- c6 N: ~' @) l. T2 H
  7. ptInsert(2) = 06 t4 h2 L0 i+ S3 ]. M; z7 G
  8. ( V% \# n( ^* |" ~0 r1 u

  9. * E! H; J% O( e# q  B* f( ]

  10. * N( l( y8 u3 Y
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    0 O& C7 Y/ }2 h) z7 J# F8 i* a
  12. 'lastSel.Select acSelectionSetLast
    4 p6 C9 k9 v6 F( P
  13. ' f& s$ f; {& {. M8 e3 A
  14. Dim B As AcadBlockReference '声明一个块参照变量: g% z" e: Z5 p+ B8 j2 t
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标( m, V+ S2 L) C. {' e7 o9 \- m* x- k
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)5 H7 r3 v( e6 e
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组: f$ y. B0 Y7 h$ e4 U
  18.   M: N. q4 i* G8 K; b3 ?
  19. 'lastSel.Delete '删除选择集& D! D5 L1 n5 ?# U* g$ A
  20. 0 t  ~% D* K0 m3 Z. j/ M" U. J$ U

  21. , J/ k  |* w1 `' a  l
  22. ThisDrawing.Regen acActiveViewport
    & p$ x! Z8 T. o

  23. 8 ?0 }. W, _# b& G7 i( y* R

  24. 7 B4 L& J* L' L# v: @+ p# e
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑
+ T7 a8 k. S7 w1 @. L, X% f
* X. K. |+ R0 a9 B7 v9 M5 c首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:
0 {1 d' {' Y; n+ e; ?7 z% h- U
  1. pNew(0) = P(0) - 500& N/ s3 ~: S# w: T+ X/ \" {
  2. pNew(1) = P(1) + 1405.8
    : |( Y5 \( @' D5 r% n1 _0 C
  3. pNew(2) = P(2)
复制代码

' W! l& t" w4 ]8 I7 J( q  @我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?1 m: ^: b8 A2 B5 m! e% W: Z; ^! f' ]
就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。' j$ s3 U$ O1 X9 p
谢谢版主8 q3 [" _) o/ b" b
8 ?! }. i" i! w# l4 y

" D; `2 D/ S9 [5 A5 I5 i6 M1 I
  1. Private Sub cmdInsert_Click()7 Y8 _3 Y( O- P
  2. Dim ptInsert(2) As Double
    + W  y  g3 E) A: Y; x0 R1 b
  3. Dim lastBlock As Variant
    ; o) f/ h9 ]7 ]- A4 F, m, E( l
  4. ptInsert(0) = 0
    # w# B! Y: M4 J4 ~* O
  5. ptInsert(1) = 0
    3 E! k, p7 X. B% _  d
  6. ptInsert(2) = 0
    7 e. E, H& c4 k' x$ _7 |

  7. & ]& ^9 U" j- p- v- r4 J
  8. '----------插入块A 仅仅一个---------------------------------& X3 t) i) \; T* k, h. w
  9. Dim B As AcadBlockReference '声明一个块参照变量
    ; T- E, }# _/ [+ I" N  g% c5 u
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标* H! r0 F/ a' V% l
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    1 W% H$ y+ T1 l- H' [
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组/ C, B/ q- }7 }! E
  13. '----------插入块A 完成---------------------------------# m4 `  d9 O" B; R: c
  14. 8 [) v/ h( ]& L% x
  15. '----------插入块B---------------------------------" e8 o5 n* X9 ^& m- [
  16. '第一个块,需要单独插入
    3 _6 I- g, [$ q) n( g6 J7 n
  17. Dim pNew(2) As Double1 [% T1 d4 j  S% |  @
  18. pNew(0) = P(0) - 500: b" Q: s* L) w5 c, z0 i% B* m7 Z
  19. pNew(1) = P(1) + 1405.82 O, J2 N# g! H7 g$ A* A' W
  20. pNew(2) = P(2)9 s& J6 k) ]& i2 |5 d# M
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)$ p: A, Q8 W  n. j. F
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组: a; H7 K, |9 G9 N  y
  23. ThisDrawing.Regen acActiveViewport
    ! ]  s: y+ @; J$ Z* [
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑 # `7 H0 V. t3 @" |& K+ O# m; j* m/ p

& t; O5 a' q: a. R" o4 u# [3# tataki
* a  _; h  M- O  o& A% c看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 ' K$ Y+ P% d" O
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角
    ; e. p, i" R/ P% k7 c
  2. Dim MaxPoint As Variant'右上角
      q- Q3 t( u3 K( N6 Q% e
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!
/ |% J6 L/ q8 H: h' j2 c2 O  W原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..7 N! \. N+ f3 N8 p( T1 {
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。# `' B/ k, z3 L0 W/ x

0 X' q$ R2 v2 Y7 L7 n  j另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..+ W+ u4 [$ V+ n2 I
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...+ Z% {& a7 Q9 o8 B" A6 i. n
tataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif

8 J- |  u) h; V7 }9 s( @" g  tlisp一头雾水还能设置捕捉,牛啊!说得大家一头雾水~~
发表于 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 )

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