QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
5天前
查看: 9211|回复: 8
收起左侧

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

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

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

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

x
我定义了4个块,想通过输入每个块的数量达到左边的效果,就是块能自动在我需要的点插入,不用手动选择。. B0 _% X7 j1 U8 ~  A1 N+ p+ {
其中blockA作为基本块,我指定插入点是原点,当要插入2个blockB时,我是想这么实现:先获取上一个创建对象,也就是blockA的坐标,但是有两个问题:: k' G. W! c* ~. n( P5 f% Y: _4 L
1.我知道有acSelectionSetLast的方法,但是不会用,怎么把选择的上一个创建对象赋给某个变量然后提取需要的信息呢?
# M* O% i0 R; I  d! S3 |2.我想获得的坐标是blockA的插入点坐标,这个怎么实现呢?6 r. N# X# N& C! A- ]7 `
之后blockB的插入点就根据blockA的插入点通过计算后插入就行,现在卡在那两个问题那里了
3 D8 B; X$ i, D版主和高位高手们支个招啊。我把图形和程序(论坛不支持,我做成压缩包了)都上传上来了。谢谢
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()
    , h6 A% U1 ]. V) Z+ s
  2. Dim ptInsert(2) As Double6 F; R$ v  b1 m* J. Z
  3. Dim lastSel As AcadSelectionSet0 D6 F$ b  ~3 N: `
  4. Dim lastBlock As Variant
    . Q& g4 ^9 g3 F. A% i
  5. ptInsert(0) = 0% X& f: b8 J$ E) {* j
  6. ptInsert(1) = 0
    3 F9 b  h0 X8 E, J
  7. ptInsert(2) = 0
    5 R) L3 p4 ]$ F1 [, s$ z
  8. ThisDrawing.ModelSpace.InsertBlock ptInsert, blkAName.Text, 1, 1, 1, 0
    : \  {+ I+ m8 t2 Y- h* I

  9. $ F, H% T! J$ X- K1 J* P

  10. , R: L0 H% f# J" `6 P: `

  11. 8 G+ m( X; }  v; F4 Z4 p; t
  12. Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '
    ; O9 D/ d# E, g, ^: x
  13. lastSel.Select acSelectionSetLast
      l4 q% {1 o+ P+ V4 @9 K/ L2 e
  14. 2 P5 t0 X7 X* ^
  15. Dim B As AcadBlockReference '声明一个块参照变量( @) u3 f# U: p1 [0 x7 c
  16. Dim P As Variant '声明一个变体变量用于接收三维点坐标5 u' H9 U" P& X
  17. Set B = lastSel(0) '把选择集中的第一个(也是唯一一个)元素(最后创建的对象,即上一步在图形中插入的块参照)赋值给变量8 z! X' b0 x+ Z( m- |$ x) a( G
  18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组: Z3 `7 N4 i- J

  19. # o. ~( J7 S* P0 @* _) _! i5 Q
  20. lastSel.Delete '删除选择集- R1 i% K' N1 Y' ?4 V1 u7 f
  21. 1 }5 ~" N6 j9 i
  22. 2 M! q7 g+ J6 P# E
  23. ThisDrawing.Regen acActiveViewport
    9 |0 ^* g( a, t

  24. $ n! U0 v7 d6 D4 f8 j

  25. ( W; `/ T& Z$ M6 M1 K5 H! i
  26. End Sub
复制代码
不过,对于本例,完全可以不用选择集,直接使用前一个对象的返回值.如方法二:
  1. Private Sub cmdInsert_Click()
    . L' F4 Y  f; z5 O+ K4 P  n
  2. Dim ptInsert(2) As Double
    ! n9 |+ b  h# c2 K. m' [
  3. 'Dim lastSel As AcadSelectionSet+ j1 _) o) o, V) l" u
  4. Dim lastBlock As Variant) r; s7 q5 `. W
  5. ptInsert(0) = 0  g& M% Q1 d4 j) V) ^" V3 W, F- A
  6. ptInsert(1) = 0
    ( r' F, U( R) e- D5 s
  7. ptInsert(2) = 05 O8 B; S/ n0 {

  8. 8 E/ M. P, I/ `# q8 O) K7 \3 u2 w$ `
  9. * p8 _3 [6 {: [0 r- C, y+ v; M: [

  10. 7 O2 D# U1 o! ]9 z' G; e; w
  11. 'Set lastSel = ThisDrawing.SelectionSets.Add("SSet3") '% t3 [6 [  P) ^; G- j( D
  12. 'lastSel.Select acSelectionSetLast
    8 ~2 D' c; G% _1 A* K6 h
  13. 0 F& ]2 q( B5 K3 m
  14. Dim B As AcadBlockReference '声明一个块参照变量0 y% \/ e- z) ^- w
  15. Dim P As Variant '声明一个变体变量用于接收三维点坐标7 d' s+ Z! s2 p! L4 {% I) m
  16. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    $ P( {$ T0 r- N$ f
  17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组  y$ a# F. B8 f
  18. / ^+ K) N4 l* {8 |
  19. 'lastSel.Delete '删除选择集5 b. o5 G0 P) G$ W; |7 L
  20. 0 c5 {: J5 t3 }3 I, y

  21. / U: |+ f* D* f( S7 K7 p7 S& A( j* J
  22. ThisDrawing.Regen acActiveViewport
    " k6 I6 F" o: @$ ]* M7 Q- m
  23. 0 j* D# u7 Z7 ~  ^" {9 c$ W& a

  24. . T+ ^# a8 a$ Y/ J: m
  25. End Sub
复制代码

评分

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

查看全部评分

 楼主| 发表于 2012-4-4 09:33:50 | 显示全部楼层 来自: 中国广东珠海
本帖最后由 woaishuijia 于 2012-4-4 11:17 编辑 / S+ I8 ?" S5 S
1 Z/ Z$ v- S7 o/ X' ~+ {; ]# ~; }
首先感谢斑斑大人一大早的悉心解答,你说的第二个思路很好,不用选择集,直接使用块的insertPoint属性获取插入点坐标。我又学到了一招,呵呵。我修改了一下代码,现在可以按照坐标计算后来取得blockB的插入坐标,但是存在一个问题,换算后的坐标实际上和blockA的左上顶点坐标有出入(y方向出入0.72,虽然很小,但是显得不够严谨),因为我是用下面这个坐标换算得出的blockB插入点的:
9 g6 V, X. u: ^/ B- O; A; @
  1. pNew(0) = P(0) - 500
    5 l1 X3 m; J7 I. D& E' |# n0 J( S
  2. pNew(1) = P(1) + 1405.8
    2 e9 q# g/ m- \# Z0 U0 w, j8 q
  3. pNew(2) = P(2)
复制代码

7 j" i: p" m( X5 f6 T" L* {6 c我知道出现问题的原因可能是精度问题,所以再请问斑斑大人,可不可以让程序实现在插入blockB的时候,系统通过捕捉blockA左上角顶点来实现呢?" V" `0 l" c) r
就是Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)这一句中,pNEW如果能是系统通过顶点捕捉后自动产生的坐标数据,而不要是我通过换算后的坐标。
+ N6 q! a* r6 I3 W. \谢谢版主
, X! j, T1 O7 Y/ k7 M( O0 D/ Q6 z7 {( V+ |
+ K8 u$ r* B& ^. p6 y- W
  1. Private Sub cmdInsert_Click()
    ( |, E) L2 {2 a  A: @3 v
  2. Dim ptInsert(2) As Double
      c, ^/ ]! r; X5 E; O
  3. Dim lastBlock As Variant
    % H4 Z$ k0 e# o" g! X2 K4 w
  4. ptInsert(0) = 0
    & `- s3 f" U  F$ i2 A
  5. ptInsert(1) = 0- N3 g9 Q  G, g, Q! n& Y; U9 Z( w
  6. ptInsert(2) = 0
    9 Z8 o1 u, i* B% E# g

  7. * t  k: B; q: q+ u! l7 ^' T  d
  8. '----------插入块A 仅仅一个---------------------------------
    6 C/ r. D7 f! r) _4 A8 y' }8 ~
  9. Dim B As AcadBlockReference '声明一个块参照变量2 v# n# P% R! C
  10. Dim P As Variant '声明一个变体变量用于接收三维点坐标1 q% [6 v0 p  A6 b7 Y5 C2 c
  11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)  y5 o8 G$ N% B
  12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    $ F6 n0 P3 u: n( C
  13. '----------插入块A 完成---------------------------------# F" q$ J# I, S3 T& A$ `& }  V

  14. 8 p. W0 @6 Q6 y% n. h- b
  15. '----------插入块B---------------------------------
    # r& x9 ^1 h+ T+ y. _( s
  16. '第一个块,需要单独插入
    ( P1 X  M" Z& ^- ~  U8 F% U
  17. Dim pNew(2) As Double) ?, G+ z+ o! I0 R" u# t7 F. a
  18. pNew(0) = P(0) - 500
    : h0 _8 g0 H3 R$ A
  19. pNew(1) = P(1) + 1405.88 b6 S' H, [& G8 T5 C  t* j
  20. pNew(2) = P(2)
    5 M% v% n  @8 M% W9 g/ l) ?, [4 y
  21. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    6 I( T7 A6 ]* x1 y1 q# k" X8 r0 p( h6 b
  22. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组. Z4 R8 U) \5 V. t6 g; q$ P
  23. ThisDrawing.Regen acActiveViewport" O) S0 x# m1 p2 A4 [3 s4 I8 L
  24. End Sub
复制代码
发表于 2012-4-4 11:27:05 | 显示全部楼层 来自: 中国辽宁
本帖最后由 woaishuijia 于 2012-4-4 11:30 编辑
$ w2 H% t% p8 Z# F% U, [) A$ E4 `' J) c( q4 _
3# tataki 7 F$ s5 p; ?" i/ v4 \* w# x
看了一下你的图,blockA的高度是1405.08,而你在代码中却是
  1. pNew(1) = P(1) + 1405.8
复制代码
当然相差0.72了,呵呵 8 c9 h7 \+ ^( N4 `$ U, _
VBA不能实现对象捕捉,但可以通过图形对象的GetBoundingBox方法获取图元对象边框的最大和最小点,即对象在图形界面所占矩形范围的右上角和左下角点.角点是以 WCS 坐标值返回,且矩形边与WCS的X, Y, Z 轴平行。方法是
  1. Dim MinPoint As Variant'左下角' y+ L7 W$ D% O, L
  2. Dim MaxPoint As Variant'右上角
    2 A9 B) a/ B! C
  3. object.GetBoundingBox MinPoint, MaxPoint
复制代码
然后再通过这两个点坐标结合对象的其它属性进行相应的计算
 楼主| 发表于 2012-4-4 11:52:18 | 显示全部楼层 来自: 中国广东珠海
呵呵,漏看了一位数,罪过罪过啊!
  {3 N: r6 O; L: u8 Q, K原来在VBA里不能实现对象捕捉,这一点真是没想到,在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
: h1 ^! r" r# W* H% E哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各有千秋。7 W& k" \6 X$ E1 _3 W
( l+ C6 n2 W/ F
另外,GetBoundingBox这个方法我知道,以前发过一个帖子问过,当时也是斑斑给回复的,呵呵,印象深刻
发表于 2012-4-4 23:04:16 | 显示全部楼层 来自: 中国江苏无锡
在lisp里我记的可以通过设置好捕捉模式去捕捉点来着..
+ C' r# M# E! O/ u5 H哎,可惜lisp的语法常常搞得我一头雾水,也慢慢放弃了,转投vba,两者各 ...
4 s% w) M7 ]- p" R# ytataki 发表于 2012-4-4 11:52 http://www.3dportal.cn/discuz/images/common/back.gif

8 T+ \5 S  u0 z1 Mlisp一头雾水还能设置捕捉,牛啊!说得大家一头雾水~~
发表于 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 )

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