QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。- P- W& O7 K0 c1 G. F6 g$ n
其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:
+ Q5 A) Y3 Y8 P) j- Q2 F1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?$ Z( }6 N# _4 F
2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?7 J; ^; k5 |3 s' h- a* s
之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了
+ K" V) u$ a: k; o版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()
    ( i+ Q, M1 X: r2 f3 j4 c
  2. Dim ptInsert(2) As Double+ `% x: O* G4 k0 A) N; i$ q
  3. Dim lastSel As AcadSelectionSet
    ; [* L! J+ u. G: Q6 G, u' N
  4. Dim lastBlock As Variant7 Q' L8 ?2 e9 f4 O( k, X
  5. ptInsert(0) = 05 a9 j! r. i* c' y+ G: q1 k% X: \
  6. ptInsert(1) = 0/ J% M4 @  m" Q9 f! D2 [( D( b  H
  7. ptInsert(2) = 0
    4 Z$ q0 b5 L  x: R
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0
    ' r0 H( c, S* d8 b5 K

  9. ! s5 h% k+ N3 D/ [

  10. % s" m$ R, |! R1 v! a6 C8 B
  11. 3 G( h! I* \+ I1 v& T: s' G" f
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '& Z" }7 k5 W. J  @( G5 Q
  13. lastSel.Select acSelectionSetLast8 h# W( O& Y  X* b, ]4 w
  14. " C' I5 x4 L* s4 g+ @& ?
  15. Dim B As AcadBlockReference '声明一个块参照变量
    8 G6 S0 Z- G/ h* G$ i/ }
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    . c+ ?  ?" R0 l+ c% W
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量: z, m6 P. O: [$ b
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    0 b# X: A8 x& s* }4 j

  19. * l7 f! v$ h0 X- T0 l" z5 P
  20. lastSel.Delete '删除选择集
    & l& V2 T& B) g8 R" f. _' D- E

  21. ; x6 x+ B. l8 p5 ^) r

  22. 2 q6 t  ~7 d& v' C0 M
  23. ThisDrawing.Regen acActiveViewport7 u8 m9 f4 [( A- e8 ?
  24. : j, B" s7 T5 m: c
  25.   {/ U0 x1 G) b8 U5 w3 x: s+ t( ^
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click(). R! K2 K. x6 k- m6 o1 S! n5 a4 u$ c
  2. Dim ptInsert(2) As Double
    ! h& |7 f  ^8 f2 r1 ^
  3. 'Dim lastSel As AcadSelectionSet
    6 y) m! k: h0 _2 ^0 j  V
  4. Dim lastBlock As Variant+ m% T2 I) b- w1 y  ?7 z/ Q2 t
  5. ptInsert(0) = 0* i1 v0 U+ R. G! M3 z/ }
  6. ptInsert(1) = 0
    + s' h' ~  v9 P
  7. ptInsert(2) = 00 h8 o3 g5 G2 P% W, N2 `" b

  8. . V/ k) E7 Q2 I" M6 s( ~! I

  9. - h% w9 T( p& C. ~; S% W

  10. 8 n5 s/ e! s. k; B
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    % a+ R9 {2 _) {# r4 u+ K$ S
  12. 'lastSel.Select acSelectionSetLast! a2 h. k( U) E- A- L" I5 h

  13. : M8 R4 I" B+ O; u
  14. Dim B As AcadBlockReference '声明一个块参照变量' ?$ d! n! c) X  N& [7 I3 V: N6 \
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    * A0 p3 S5 h! A8 l
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)7 Z0 P9 k$ G+ w$ y: ~. o/ ~
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    % Q  o, q# \% e

  18. * z% Y/ \' f1 `: i  L; W% H
  19. 'lastSel.Delete '删除选择集
    - L9 ]. V+ P; q0 P; G6 ?4 p
  20. % Y2 t: f# b  L

  21. . @1 k  M' b* D& l- V6 q
  22. ThisDrawing.Regen acActiveViewport1 X, F' H, O: L; R& \3 G3 n
  23. 4 k7 |9 E; `& e* j' H7 E5 S! r
  24. * K1 ]7 m# n% }; Y
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑 " i' C; C. R) p

$ K+ K2 h& l: l首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:
, e' x: U* H+ v$ z9 l% k
  1. pNew(0) = P(0) - 500/ b/ U0 j9 ^5 E8 ^! {
  2. pNew(1) = P(1) + 1405.8, ^; V; t4 k$ k' Z
  3. pNew(2) = P(2)
复制代码
  L* T  m$ W9 U& h4 D
我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?
7 f  @  W* r3 n. |就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。3 K6 O* x2 P# ~7 u; ?3 H* Z
谢谢版主
- p! c+ x, Q  d0 A- a$ O' z9 V6 y& o) d9 e

0 U# M, k% S8 O0 f3 j) h; P
  1. Private Sub cmdInsert_Click()
    ' Q! M! Z! B8 h1 s# U0 t9 @
  2. Dim ptInsert(2) As Double
    " s" X3 ~) T4 o; {
  3. Dim lastBlock As Variant, m3 R! Z( K+ ^
  4. ptInsert(0) = 0
    8 F$ o$ c$ l& b7 X6 [/ z
  5. ptInsert(1) = 0
    1 {. ^: \5 j% B/ n+ K; S  j
  6. ptInsert(2) = 06 _) N3 O) r+ B! m) g5 a
  7. . K. O/ |: k$ I* L
  8. '----------插入块A 仅仅一个---------------------------------0 B' M5 s* Y& Q! p4 U
  9. Dim B As AcadBlockReference '声明一个块参照变量! r6 E$ V% B1 S  ?. o
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标" l+ o3 O& ~* F( f$ D$ j% ~# P1 o8 V: F
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0); G9 V. U2 Q* X, |; d, P
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组1 }% [  k0 d9 q( Y8 n
  13. '----------插入块A 完成---------------------------------
    . J8 P0 N/ ]" p, F+ U' |  a
  14. 8 `8 m" I* X! F
  15. '----------插入块B---------------------------------
    & F% g" J  d( p9 v" ~, @
  16. '第一个块,需要单独插入5 a; G; T% s1 S/ c
  17. Dim pNew(2) As Double
    0 E! }! \, X" ?4 X3 E3 C
  18. pNew(0) = P(0) - 500
    # T8 ]6 I# v9 H
  19. pNew(1) = P(1) + 1405.80 W/ J. Y& u4 e9 [
  20. pNew(2) = P(2)$ i2 A* k4 S* v2 |1 {
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    1 h: [1 A. [: f6 a; s, s
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    3 a# Z5 R0 H( b/ i* y" h, C
  23. ThisDrawing.Regen acActiveViewport7 j( |9 `& {+ _4 Z$ ]8 {
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑
+ {$ k3 ~% e) q6 T  }) V% e/ E
# p. s4 V! @8 d; i/ U) W; Y4 F" {2 b3# tataki
$ H) C5 p1 E" z6 D+ u看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 4 n, A7 C/ n$ }7 L) m- j8 R+ A# W/ s
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角+ @1 q. M7 ]8 i% W
  2. Dim MaxPoint As Variant'右上角
    % U- G5 H5 _! n( v( g8 N3 ]
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!
& Q; u" _! R" M  F5 P原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
8 M+ e. t8 T* `5 H! A9 P2 t& Z哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。: n% i& J4 s6 F0 }& a: `' [! |
( T9 _) z7 K" b( R1 X5 i
另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..! W) u2 u8 G9 U8 s( e  I3 ^
哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...
5 O  E4 Z  }$ V6 `/ ytataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif
4 t3 O9 H6 g" u
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 )

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