QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。
2 l' U# ]9 L: g8 K. {其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:
! o0 M6 m) i# s* S1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?( k/ X: S8 f; \9 j
2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?
/ ]8 d4 J! N. q% q  W之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了
! g/ |, J: @" l版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()& v; V/ k: [4 [
  2. Dim ptInsert(2) As Double+ N9 s; Z) R2 v5 G
  3. Dim lastSel As AcadSelectionSet% T9 ]+ t! V7 s; J/ t3 `% k8 M+ h
  4. Dim lastBlock As Variant
    ( C& N  ?5 `6 k4 c  f: c6 C
  5. ptInsert(0) = 0. s  @1 Z5 g( s% Q  Y4 J9 C
  6. ptInsert(1) = 0! L' H6 Z+ T' O6 p! J& H$ W
  7. ptInsert(2) = 0
    & N, @/ X! n% [! p" q$ C
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 05 u- p  W9 i2 J8 C2 j
  9. 8 R  c9 O+ X2 B7 J9 K' y

  10. - Q: S0 Q( B4 b; c, E

  11. - i3 q5 z1 C) G: y# K
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
      G! b# q0 G1 t
  13. lastSel.Select acSelectionSetLast
    ; }$ N8 e7 v9 r3 ^; R0 \! a

  14. " G! b  q9 V5 z9 F' i3 R3 a) B
  15. Dim B As AcadBlockReference '声明一个块参照变量- R" L6 a! \: m
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标) g5 z$ b- X& c( P5 q& o
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量% D- U3 _$ |/ i4 O0 A
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组/ E. K+ k8 I0 s

  19. ; A4 n2 Q( l- Q7 g! ]5 i* e) J: W) j/ t
  20. lastSel.Delete '删除选择集2 B  ]4 C! |. ^. q$ b: |/ m; z

  21. ' v" B$ R4 T5 H0 e5 B
  22. * s4 ^: v1 x6 S. q0 J3 V2 Z$ X
  23. ThisDrawing.Regen acActiveViewport$ U( B2 T% q! B! Q# j0 v- k# M
  24. & Y8 f2 |* R7 w5 l

  25. . I; I' \1 E9 }/ ^5 ?
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click()
    1 Q( H, ^1 n" [; R3 M
  2. Dim ptInsert(2) As Double" \6 @" f* Q4 B9 X
  3. 'Dim lastSel As AcadSelectionSet
    8 l4 ]. k7 _- S4 S: v# I' S
  4. Dim lastBlock As Variant
    2 U, O/ v: u6 ]# E
  5. ptInsert(0) = 0
    2 E' x. {/ x" e0 U& R
  6. ptInsert(1) = 0% Q0 m2 p  D% g
  7. ptInsert(2) = 0
    : V* ]6 V: y: e: ^/ X( f" \+ Z8 L7 \

  8. : _5 h! D) B8 K4 _6 [* B3 B3 A

  9. ; i; c8 C6 E( D: L$ e' }

  10. + h* b8 i! ^4 d: e
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    0 U0 X; q! z3 x* I/ r9 N" z9 s8 y
  12. 'lastSel.Select acSelectionSetLast  d+ i+ Z" n% @% }; v

  13. 3 q4 e' ?$ C! P& ~+ x
  14. Dim B As AcadBlockReference '声明一个块参照变量
    + n1 y4 e9 [$ P2 V8 e0 d
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标+ J, d2 \3 u2 S
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)" h; s: P: M$ {
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组+ x: P: H) |& [6 v

  18. 0 p1 o4 t' h" i) q& N
  19. 'lastSel.Delete '删除选择集7 l3 j  J' f% a$ _6 A) A/ a" E  M
  20. 0 I% _+ _, z, G; A. ^1 f1 u, ?
  21. - p6 X1 `+ ~' \
  22. ThisDrawing.Regen acActiveViewport
    # {+ B# B. d9 q  U8 j2 O
  23. 2 O1 I; G. m$ P. v1 i7 R
  24. 3 r# T4 ~* R. y& o9 ~
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑
2 N; p7 I/ l5 O" x5 y8 ]; F5 \# f' Q3 P) I
首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:  @, h0 Z1 x# O9 \/ A
  1. pNew(0) = P(0) - 500) h2 B  b# v! o/ D2 z6 v
  2. pNew(1) = P(1) + 1405.8
    . @% K) a  M! x* I- i* X; }
  3. pNew(2) = P(2)
复制代码

" K9 G" o. h& t我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?
: n3 k1 f4 T* W1 T$ H) M7 d; m) ]就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。
0 d; l2 p/ ~1 o5 N谢谢版主$ }* x) ]9 \, P8 N

7 ^; ]8 p( t& r3 [; i! c
4 L3 K* J( Z0 y0 U
  1. Private Sub cmdInsert_Click()
    % H; w3 g8 p, \& I  T/ B
  2. Dim ptInsert(2) As Double7 f1 P8 ^- o1 I: g
  3. Dim lastBlock As Variant+ M, I: `3 J4 x. e
  4. ptInsert(0) = 0
    3 J2 f5 z4 R8 J8 Y$ R! |/ M0 r. L
  5. ptInsert(1) = 08 o5 i. V. ]. y( m
  6. ptInsert(2) = 0
    : S# A; v! F# p

  7. 7 q1 _: `, ]5 v3 I
  8. '----------插入块A 仅仅一个---------------------------------" m. o' V  z( w/ R* l% ^2 W! b
  9. Dim B As AcadBlockReference '声明一个块参照变量4 m- T. j2 _2 N. R/ y. A' F" ^: L
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    $ A8 N6 T& T9 R9 K$ I9 Q2 \
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)) f) Q1 x9 r' |% `& a. l, I! E
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组+ w7 m9 l+ K! s5 c! x) p
  13. '----------插入块A 完成---------------------------------; H# {9 {5 Z. l% \

  14. % B- I8 D1 I$ I  s
  15. '----------插入块B---------------------------------
    7 L$ I7 i% u7 y. a' \0 M1 M& E1 C
  16. '第一个块,需要单独插入
    6 J& h8 b# V4 p, I! X8 F
  17. Dim pNew(2) As Double: c& `/ c: c5 D0 U( g; Q) A1 a! q* E
  18. pNew(0) = P(0) - 500
    ! s& M* k0 A( a" `" Q1 w0 d1 t
  19. pNew(1) = P(1) + 1405.8
    . v( y) D6 Q+ d& M2 |
  20. pNew(2) = P(2)
    6 E# D: E+ O" q7 J/ @( b2 Y
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    ( M; O# B* _! w
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组! f) M; J+ S9 f0 e
  23. ThisDrawing.Regen acActiveViewport
    + `- L9 j, v1 X
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑 - ?1 q  \) ]! Y. o
! g& z) @3 z: }5 r: }
3# tataki ! K7 ?* y: H2 m# w; L& M7 W5 N
看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 ' ]4 ~' d" ]; k4 q( W
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角7 V3 Q/ D$ l$ e2 F8 Z  e! G" Z
  2. Dim MaxPoint As Variant'右上角8 M; l/ C! h) x
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!
. o* P/ n' t8 \2 s3 v2 G$ [7 d# \* T原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..0 H* i0 v, @; l; V  ?! T; X
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。- U2 ?% \2 G. {

0 @. G: o5 ]1 h8 n4 U) r. X5 B另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..9 t9 T1 G8 L9 f/ @" L, H
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...2 w( a2 f; h4 e
tataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif
" ]8 {1 {9 e' }8 @
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 )

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