QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
6天前
查看: 9219|回复: 8
收起左侧

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

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

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。
' s5 E" O* U: q4 F$ ?1 `' H其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:7 t( \6 y% i1 q& J1 D8 o! v6 J
1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?! u0 K% {8 _. A7 x) h0 R" j
2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?
* ]0 k) ], ^+ P, u- I之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了) M/ M* P- H/ A( z) d; L. k/ `
版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()) d- Z, X6 V( x& e
  2. Dim ptInsert(2) As Double) m- `/ Q2 |  N8 E
  3. Dim lastSel As AcadSelectionSet
    3 U) ^, c  c) B. f
  4. Dim lastBlock As Variant
    9 c8 Y' v+ s# T- T7 @: {% l0 |
  5. ptInsert(0) = 0
    $ H4 B3 q" B1 x5 B
  6. ptInsert(1) = 0
    0 j4 v* `6 ^. O
  7. ptInsert(2) = 0' G2 `" w; Z0 H- I
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0
    ( E* i, \: ~7 X, k! L

  9.   M# @2 d8 A" [
  10. / ^5 y1 [9 K' F& C/ {

  11. . D* C. F+ z" v- x4 U- H+ w
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    5 |1 U5 n6 D; q  N. j3 U
  13. lastSel.Select acSelectionSetLast
    - W* [6 l" V+ B6 Q* u

  14. / c- [6 _% k6 q
  15. Dim B As AcadBlockReference '声明一个块参照变量) Q# }) V8 O4 `: x0 S9 D5 C% M
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标4 @& I) ~- v" I" `- R
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量
    - V& d/ \% Z! U5 t, w1 r
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组" p  m$ s6 e/ W7 H
  19. / M; A) t7 _0 X& v
  20. lastSel.Delete '删除选择集" n8 g1 t0 Q1 R8 l

  21. - S, c7 h, L5 {& L/ D& Z" m
  22. 2 ]* ~1 p) `4 K
  23. ThisDrawing.Regen acActiveViewport
    / ?; o  b* ^+ K# V3 f6 @3 o
  24. 6 c# S6 I# u; w9 _3 _; Q7 V

  25. 1 c, f8 G' x: U- N/ D/ |
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click(): A2 l& [  t! I( S
  2. Dim ptInsert(2) As Double
    1 Q2 c+ m; h2 c- u
  3. 'Dim lastSel As AcadSelectionSet  W" V0 Q; z* q- x% ^9 m+ b: ?
  4. Dim lastBlock As Variant; T5 O6 H+ _7 a  A9 J( N& k
  5. ptInsert(0) = 0
    ' v" R/ N4 ?$ T$ C% }0 ]9 ]
  6. ptInsert(1) = 0
    7 \( v. }7 d8 z# f# C: [
  7. ptInsert(2) = 0: B/ G8 |% V$ t0 w9 u" C

  8. 6 G% H& N; J3 a) A# H
  9. : [& R) O2 |' p+ Z8 Q
  10. 3 ^8 Y5 F) P  E7 |1 }* u
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    $ G4 t9 N. J* U" C2 v
  12. 'lastSel.Select acSelectionSetLast; z: @4 T* i- ^* q5 G, R+ b
  13. % g2 m$ n  ?$ T. b
  14. Dim B As AcadBlockReference '声明一个块参照变量- O  |. s% Y5 f% ?; d( O2 d3 f" H
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    ; n6 C+ F: A' z& K2 X
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    % K: t( o% r' v( V" _' I
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组7 w7 D. Q' y/ E9 U( Y

  18. ) k7 {. Z$ M1 n- i+ t7 }8 F
  19. 'lastSel.Delete '删除选择集/ ]7 W- E) o; ?% }/ b
  20. , j: X* U, m9 L& G  U

  21.   B' ]6 J3 c9 l; _+ T* L
  22. ThisDrawing.Regen acActiveViewport
    2 O* r. x) g* d' z! P- q
  23. ! y/ r6 j' F7 A" J7 Y0 I: u
  24. / R/ h; L1 ^. |
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑 # O) b6 [; V( X. V

2 H/ d- x: e( B) E  l3 g首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:
* \7 [) h5 M, s
  1. pNew(0) = P(0) - 5001 M4 s, \% E$ d4 h' Q% c
  2. pNew(1) = P(1) + 1405.8
    8 v, i4 ], F) U5 {
  3. pNew(2) = P(2)
复制代码

2 m5 Z/ @$ u9 y& }- G! R, u+ `我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?
$ }; [+ L! w' z" z1 Q' x3 i就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。7 A) Y8 V7 X  R5 L) ?  O
谢谢版主( _$ n$ j/ I5 s! Z4 c9 Q4 x3 l3 w7 u
4 h) v* O$ K. b* L
, I- ~, m) `0 \% J; P
  1. Private Sub cmdInsert_Click()
      X+ J) E8 n/ k) p% U; M% u" X0 \
  2. Dim ptInsert(2) As Double7 S- W5 h" F, C8 L3 j
  3. Dim lastBlock As Variant
    # d! v$ {% e# b* j
  4. ptInsert(0) = 0
    8 C2 L- f+ s7 p5 g
  5. ptInsert(1) = 0, A! O# P4 R9 J3 {* x
  6. ptInsert(2) = 0
    * b9 u; Y' L  z$ D7 y: b1 [
  7. ! E: r3 G0 T3 B7 w$ A/ T; p
  8. '----------插入块A 仅仅一个---------------------------------) J" e: R% r# I
  9. Dim B As AcadBlockReference '声明一个块参照变量6 I9 X7 j* [0 i+ z
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标+ A: \7 `! c  W4 \  m$ s
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    ' ]5 l7 r+ q( `# e' s- P4 Z/ E
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    7 H% f+ c* m5 m: s+ ]8 c. \! x
  13. '----------插入块A 完成---------------------------------
    ! j& {5 S' m; [

  14. 0 Y/ m6 ^5 ^! N# X2 `  |' Y
  15. '----------插入块B---------------------------------
    4 M: J% x# z1 q* t3 r5 |
  16. '第一个块,需要单独插入+ t' c- G9 t+ K- E
  17. Dim pNew(2) As Double; f* w6 A6 @8 S8 h7 k$ }
  18. pNew(0) = P(0) - 500& q) z: S  g: G/ C7 ]7 R
  19. pNew(1) = P(1) + 1405.8
    " H& x# y; ?2 _. k8 N+ y# e$ r
  20. pNew(2) = P(2)
    $ l7 Q7 R$ ?3 I- Q
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)3 g( _% p) I# `: W5 z7 j
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组0 J- d% T8 H, L3 V4 t0 X; R$ {2 m
  23. ThisDrawing.Regen acActiveViewport+ W" N8 v2 A# i
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑
' s, N' W/ |. V1 d/ L& |0 I
  B- o$ P4 \7 A+ A6 v& K, `3# tataki . [* P9 O) \( r$ I# U1 K3 t
看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵
  Z+ \' H6 m3 P  D2 l& }VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角
    ; P" J6 x7 a7 K: _' B
  2. Dim MaxPoint As Variant'右上角
    & J7 r& q4 q- ~3 g
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!
" F* G  _, m: p原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
5 U$ X8 K; ?% _; a哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。3 F; ]2 ?: v, X8 M, b+ R# k
: j: U% A$ p3 f4 V& p! P2 w
另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
: _; |/ D0 Z8 s1 n9 \哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...
4 h4 k2 f1 m- a9 {8 mtataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif
: _/ P0 a/ q1 n  r$ g
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 )

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