QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
goto3d 说: 版主微信号:caivin811031;还未入三维微信群的小伙伴,速度加
2022-07-04
全站
goto3d 说: 此次SW竞赛获奖名单公布如下,抱歉晚了,版主最近太忙:一等奖:塔山817;二等奖:a9041、飞鱼;三等奖:wx_dfA5IKla、xwj960414、bzlgl、hklecon;请以上各位和版主联系,领取奖金!!!
2022-03-11
查看: 8580|回复: 8
收起左侧

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

[复制链接]
发表于 2012-4-3 19:49:29 | 显示全部楼层 |阅读模式

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。
# x( P2 H% e" _5 @% Q: q其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:
( x9 k' O: ~1 d2 b1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?+ L) w3 P0 l: Q* k& N
2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?
5 i' \! t9 t4 O; x之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了7 }6 e1 r; X. ~  J
版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()" b2 d0 k* q) Z
  2. Dim ptInsert(2) As Double% G; j8 H( [# q) h6 F
  3. Dim lastSel As AcadSelectionSet
    % a) _; }+ ^- r7 `3 m* B) P6 C" a
  4. Dim lastBlock As Variant
    6 p& T  @! r* Q) m5 h* U
  5. ptInsert(0) = 0
    * N4 ^) |5 ^( [. B% `; J3 v/ A% Z8 l: `
  6. ptInsert(1) = 07 f% J7 N2 b6 v8 S2 t0 H( _
  7. ptInsert(2) = 0
    ; |0 i4 l% m, S$ l% f9 C
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0* ?! N2 y. q3 J! x$ n. X- D( i( X

  9. ; V0 A& M7 D6 E8 [1 u

  10. 3 _0 r% v9 ?1 ^" A

  11. * I5 J2 O. {% T+ m' N0 L
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
      i0 E9 L1 ]( T1 \+ z( P7 h+ F
  13. lastSel.Select acSelectionSetLast
    / R4 d; e8 b" v3 \  \4 W

  14. " C% M) O4 z0 d5 D+ \
  15. Dim B As AcadBlockReference '声明一个块参照变量# V5 p: L  }0 a+ R* \. P
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标! y. |. I/ Z4 Y2 P! a. }* g
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量; b" ~0 ~5 c5 j) L7 `+ \6 X
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    7 e# w/ a$ L" R

  19. - }4 p; a# L" I5 n# Z
  20. lastSel.Delete '删除选择集  X) x" v/ [. h( q$ G
  21. : A: I( K5 Q8 k) A1 E
  22. / Q, \6 c3 U3 g+ o! k6 S
  23. ThisDrawing.Regen acActiveViewport7 }; I* ^+ l/ K1 d$ T' x. L, w3 z
  24. 3 |# Y; W! o+ Z: F1 O

  25. 0 D2 ?7 ~9 q+ h$ i1 B
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click(); n& z+ E6 i. D9 b
  2. Dim ptInsert(2) As Double9 u4 [/ ~; k! i. }4 C% z
  3. 'Dim lastSel As AcadSelectionSet
    . m, U' S9 {9 m% b4 W* }
  4. Dim lastBlock As Variant+ S& R! V- a/ [: k( i
  5. ptInsert(0) = 00 I6 V( G3 H$ z( q
  6. ptInsert(1) = 0
    " Y* B: J, m4 m# k8 P) x
  7. ptInsert(2) = 0  s7 c% U% E- q& ~

  8. 2 _( Y% i& R8 g; P

  9. $ k7 Z2 l/ H/ k
  10. ! Y8 L7 A5 @! F' D3 U( \/ x
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    / v! j3 e/ g; a/ M3 a9 S; L
  12. 'lastSel.Select acSelectionSetLast+ X0 s5 c6 J3 n) J2 I9 }9 U9 T0 C
  13. * K  }: F% t1 J0 ], T
  14. Dim B As AcadBlockReference '声明一个块参照变量/ a/ o+ Z4 ]) d6 T4 `" u' O- R. e
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    ( X" z% B" _) P  `+ j
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0), |+ m0 R( i) e  P' ~. s
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组4 i0 l6 w% t: Z+ E# F0 E
  18. ' k- i6 @' W4 y) B9 |' M- D
  19. 'lastSel.Delete '删除选择集! w5 n. O& [" y+ {5 s

  20. " m# p& b  U. {: C+ i- H, h0 N& y& L9 a
  21. 9 U& Z8 |  M5 K
  22. ThisDrawing.Regen acActiveViewport
    # R1 R3 I# c& @" _

  23. $ o4 _1 Q# E* q4 `7 s# m

  24. + Q0 j6 D* Q7 K2 i" b! r
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑
& _! v" ?9 Y) ~/ C, I
6 s' E* x% _  g首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:
/ _) C* I) W8 ]) _$ c
  1. pNew(0) = P(0) - 500! u9 ^& C) ]: V; ~
  2. pNew(1) = P(1) + 1405.86 L. k0 N$ O" a1 ?
  3. pNew(2) = P(2)
复制代码
% g7 N; {+ b4 t( H8 B
我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?
8 w. @! _# v  f# @9 ]/ J, q就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。
7 X- O. G0 B9 K谢谢版主* b! Y) @, A3 j% D) W
  ~2 v5 n; b, o( E: w
  H# I; m( i$ j
  1. Private Sub cmdInsert_Click()
    4 U0 b; d3 E7 R
  2. Dim ptInsert(2) As Double
    7 H, G$ r# X- q! W' `+ r0 W
  3. Dim lastBlock As Variant
    4 w4 e1 ^! ~. C* {4 t3 Q5 ~( L
  4. ptInsert(0) = 0
    . u1 ^: p3 R, [8 D
  5. ptInsert(1) = 0  x/ @- k/ {2 s5 a
  6. ptInsert(2) = 0
    1 M% y; b1 \7 ~* j1 \; c
  7. 8 w8 F- y+ w5 I; _
  8. '----------插入块A 仅仅一个---------------------------------/ I! ]5 z1 ~8 b  Y& J
  9. Dim B As AcadBlockReference '声明一个块参照变量& y) E6 R) f& k/ C" G; T3 e  ]
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标3 P. W: B: v4 z- d
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    ( Z7 p. B4 O( X- [2 Z4 @9 _
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    8 O' Y( f* Q& R$ H) L" h
  13. '----------插入块A 完成---------------------------------
    0 N9 m: G5 M7 P2 y8 `
  14. 9 s, q" u) g' P; J2 U5 K/ _. V
  15. '----------插入块B---------------------------------* [# Y) i- O$ q9 }, N0 V1 E
  16. '第一个块,需要单独插入
    ( b5 c( C9 Q6 `; `* H9 j6 ?5 I0 X' B
  17. Dim pNew(2) As Double2 v* b" O' W3 v" X' g
  18. pNew(0) = P(0) - 500. p2 w/ G2 p' r( J2 {. v! A' Y
  19. pNew(1) = P(1) + 1405.8" E2 {8 k# G" M8 |0 f
  20. pNew(2) = P(2)2 T' T! G& S/ D' j$ z3 z7 i
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)/ W) y' D4 @8 E) G  Q3 h
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组3 s5 w& }% R, A5 I3 U
  23. ThisDrawing.Regen acActiveViewport
    2 M+ R, S6 B5 @5 e( Z
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑 ! g  y9 _7 ]& Y! V3 C4 b5 J
: C" Z. q# ?2 P! z6 z2 B
3# tataki + I/ _" S: y$ G6 \% t: o7 Z: A
看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 % W9 f# y% r& Q- p3 X- ^7 }
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角
    + S4 a" z4 r3 g/ F0 D2 y
  2. Dim MaxPoint As Variant'右上角
    % Q& G! z3 `. _$ g; I
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层
呵呵,漏看了一位数,罪过罪过啊!
+ u5 p. v9 f# l4 T. V0 I8 o原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..) ]$ C! d+ v9 |, ]
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。9 T" P, I9 y; Z; [) ?7 \
4 V: s* g" e- ~. b3 [+ m! H9 l: m
另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..& K' Q2 d: F9 ~8 p$ O! K9 N
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ..., X$ K# M1 N5 X' M3 [$ W
tataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif

4 p, k+ R8 y3 H% O$ }6 _  u6 llisp一头雾水还能设置捕捉,牛啊!说得大家一头雾水~~
发表于 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备13008828号-1 )

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