设为首页 |收藏本站 |帮助 |加入VIP |积分充值

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

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

[已答复] VBA如何填充一个三维四边形？高手指点~

[复制链接]
jjww123
发表于 2009-2-4 23:33:32 | 显示全部楼层 |阅读模式 来自： 中国福建福州

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

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

x
Dim object As AcadSolid
; x% b* [3 _9 n  [# ?" ZThisDrawing.SetVariable "fillmode", 1# W  f/ d9 n4 ~) j# H
Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
, \. {: W( h. s- ^& \6 `# eobject.color = 6
0 s( D7 J8 H# E) p2 L# Q+ V# j6 T% P8 X  @
' i2 D3 @' F4 W1 j! k/ h
点已经定义好了。。只要这4个点是二维的。。就可以填充。。。但是如果点定义为三维的就不行。。7 U- {- X9 x$ F5 Z/ Z

, j+ T  E* P4 a7 h0 N高手指点！
回复

举报

woaishuijia
发表于 2009-2-5 11:14:02 | 显示全部楼层 来自： 中国辽宁营口
solid（二维填充）对象本来就是二维的
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 11:39:04 | 显示全部楼层 来自： 中国福建福州
那如何填充三维的面呢？% Z3 a$ g# e8 x: h

8 G4 N8 `4 y  t% J0 Z: b我这4个点是在XZ面上的一个四边形。。。
. Q, Z+ p2 C) C$ g. k: r$ D2 |; X4 r* c" f8 ]! b4 V1 e
[ 本帖最后由 jjww123 于 2009-2-5 11:41 编辑 ]
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 13:53:50 | 显示全部楼层 来自： 中国辽宁营口
需要变换UCS2 I' y% q* H1 s* E
  1. 1 M: v! {, Y. {. Q" I1 p6 X
  2. Sub A()1 x7 |  g2 i) w! J+ j6 l+ a, a
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double" k8 Z( _4 ?1 F9 l, N2 K
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    1 Q' f! `& }- j
  5.     With ThisDrawing0 k% E; L1 j3 i$ K  e; S
  6.         '下面4个点用于定义二维填充(solid)对象6 I5 F: p: Q4 H: ^6 V  R% s
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0) k$ @4 X; m5 a/ ~* p
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0. H: k% f) H5 V" }7 U, K/ S- s
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10
    3 o2 i+ O4 ~  F
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10; d" D9 f; r4 o0 H$ u" S/ k+ ~$ b/ ~
  11.         '下面3个点用于定义新的UCS
    7 t: J! ]0 }/ Y5 D; w, ~  \4 H
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    ! U) V: T0 T# A1 F! j$ ^( i
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向6 P6 H% G: F; u
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向( G! u* Y+ H  i# b" t
  15.         '新建UCS
    1 r) J' x. T" U0 A2 _
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    5 m6 b' `6 q; S9 Y) A1 m( _) o# A1 H
  17.         '新UCS置为当前
    2 f! Y6 L# x. W
  18.         .ActiveUCS = UCS2 y9 R0 C0 v. x4 }- m4 I7 R
  19.         '创建二维填充7 {- Y# I" m( f3 p5 j$ q$ i! ]
  20.         .ModelSpace.AddSolid P1, P2, P3, P4
    - Z' p- V0 T* e' b6 p. k+ ]  o
  21.     End With1 r4 b0 ~: [" n; o
  22. End Sub
    ' ]8 a# \+ Q* Y% T6 W
复制代码
& E6 S- h4 G5 E% T

9 U( c" ?4 W- E. U. D上面代码中定义二维填充对象的四个点都是世界坐标系WCS。如果这四个点是自定义的用户坐标系UCS上的点，还需要换算坐标，参见下面的代码
* \3 |, N" [; W, P

  1. 6 p* u* H: w' p
  2. Sub A()8 \4 o* y' o& y) E: M7 x8 S
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double) w3 l- }8 ]8 ^( L
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double- b8 A( U% H7 |
  5.     With ThisDrawing
    & P7 f; @+ g5 V) q
  6.         '下面4个点（相对于XZ平面）用于定义二维填充(solid)对象# R3 {! r2 f0 B: [8 l0 C& f0 |
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0. V' z6 c, c) b' e" F0 e" M
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0
    ! m; ]+ l7 G+ F* `* z) G( w" t% l
  9.         P3(0) = 0: P3(1) = 10: P3(2) = 0
    5 a4 B: p' g2 T* Y8 c" R/ ]7 f
  10.         P4(0) = 10: P4(1) = 10: P4(2) = 0: U- t2 @% D  q% W- i+ m
  11.         '下面3个点用于定义新的UCS
    + J6 l: y. O+ o% `
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点) }6 t: o0 l1 I, r2 s0 W8 l0 g% [
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
    ! z( Y3 s) q& H( s. D
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向' }$ J# N0 g) r. m6 R4 M8 U
  15.         '新建UCS  a- F2 j/ B* |5 o+ [
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    ! ^8 `( Q( w( J/ U8 b
  17.         '新UCS置为当前: I# q0 R! ?! n8 F5 E
  18.         .ActiveUCS = UCS
    $ C% R" j6 V( f9 V* B8 h
  19.         '创建二维填充(P1和P2在两个坐标系中没有变化，不必换算；P3和P4从当前UCS换算为WCS才可以，因为addsolid方法的四个点坐标必须是WCS)
    * I7 e9 \  ]" a+ y) e9 D8 Y1 {
  20.         .ModelSpace.AddSolid P1, P2, .Utility.TranslateCoordinates(P3, acUCS, acWorld, False), .Utility.TranslateCoordinates(P4, acUCS, acWorld, False)) E! ]8 f3 M9 k% z7 L
  21.     End With
    : r: s. s$ D, V+ s
  22. End Sub+ |/ [8 t# s# r
复制代码
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 14:11:20 | 显示全部楼层 来自： 中国福建福州
哇。。太感谢了！太谢谢了！我慢慢看。。。。先回帖！
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 14:57:57 | 显示全部楼层 来自： 中国福建福州
版主您好！请问为什么画出来以后无法显示颜色。。必须要选视图-视觉样式-真实  以后才能显示填充以后的效果？2 @2 q* L2 |/ q. [
7 |4 L; d) k6 L9 l4 A4 @
4 u* |; i7 g+ i
'下面3个点用于定义新的UCS
7 B/ p6 ^! {# _1 N" U/ H    Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
9 N, a2 z+ a" K% e- d    Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
7 `: @: d$ w, C; y    Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向; t1 g; t% L- ~. U; f9 w
6 Z2 N  }+ o8 B# {
    '新建UCS/ h) i% V* r( @% O, b* b: {2 h
    Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")) E) q" P+ P* V" `
   
' Z+ g8 _, p/ p6 G8 |    '新UCS置为当前+ |" l: W# D! x0 H. N3 Z* s( K6 o$ H9 i
    .ActiveUCS = UCS
: w# l8 I: G0 f$ a7 I   
$ M3 P- w0 \* m4 {6 I: X   
* n3 r- |" I9 a/ ^- L! t    Dim object As AcadSolid! }& E  R4 g4 _' x- Q
   
9 v7 h7 K( c8 j4 S! L2 [' U( A    Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
) f, ~( ]9 ^: q    , C3 d$ i: ]9 O6 [/ p# F
    object.color = 6
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 16:38:26 | 显示全部楼层 来自： 中国辽宁营口
“FILLMODE”系统变量设置为1并且视图方向正对着二维实体时才能看到填充。
1 n$ m! R2 V" i7 R- q4 ?9 P3 I7 r可以在上面的代码中再添加两行，如下3 m  ?2 s% l& o% \" i# ^4 j5 J

  1. + v3 S0 X. K* M/ X6 [
  2. Sub A()
    3 q! ?; F2 C- g8 u, P( w; H
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
      ~& X, @* F8 e# l9 P  I
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    : S8 o6 s7 o$ S+ a+ c
  5.     With ThisDrawing
    ' F, ^/ U; A$ k5 |
  6.         '下面4个点用于定义二维填充(solid)对象
    & E) X; k  v3 U
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0
    ( H3 B4 o! ]5 N1 Y, Q" ?3 l
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0, `  \: f# S7 T8 C8 Z% I
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10) T' b+ h. r8 P" v
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10
    ! ^: h' G6 e0 c* }, x- N, m/ V
  11.         '下面3个点用于定义新的UCS
    7 o' \5 W7 f2 ~4 H6 n* V
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点* i3 B, X. U- w7 I+ `9 p
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向2 g9 p' p' K5 w
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向* I3 M0 e0 Q# q; M8 w8 z
  15.         '新建UCS
    6 D. \6 c+ y5 z9 [
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    ) ?- ?+ b# C8 G$ t  U& u" I6 O
  17.         '新UCS置为当前
    - s' a( y+ |+ u
  18.         .ActiveUCS = UCS# s5 W/ V, R! O4 h3 m
  19.         '创建二维填充, A1 }$ I2 Y" O$ E
  20.         .ModelSpace.AddSolid P1, P2, P3, P4
    ' u) `0 Z/ j$ _" `, G
  21.         '发送键盘命令，使视图对正当前UCS。注意plan后面有两个半角空格，相当于两次回车  r% J, ^1 j9 l
  22.         SendCommand "plan  "  K3 k" S+ N0 W# Z
  23.         '修改系统变量（CAD默认该变量值就是1，如果没有修改过此变量，则此行可以不用）
    # O/ \  O" X8 L
  24.         .SetVariable "fillmode", 1
    - ^6 a& M# Y* z( X) o* o, N9 @, L: n" |
  25.     End With3 \  d+ z& S' h' U1 p8 @
  26. End Sub
    2 q' \! K1 Z. D+ E( C
复制代码
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 17:09:42 | 显示全部楼层 来自： 中国福建福州
感谢版主耐心的回答。。
3 |0 r# a9 c8 }3 ]3 B( d- [. Q/ v8 C6 |2 D: d5 Q: Z
结合我另外一贴的问题。。加入以下代码以后。。视图是变了。。但是加上你上面填充的代码之后就乱了。。。3 E5 y/ _; N' F7 w" j

) F/ H: ^5 ~6 ]7 e如何在下面代码中添上楼上的填充代码。。并且正确显示呢？; |+ A4 o0 N" z2 X
) ?  x; r- S4 g7 Y: y9 g: t: p
) r1 z+ Z- r; ]6 ^) _; r& S
; y. S* s: O4 L
Sub A()
% ^- a( W* _1 v; F4 p- m# }5 w5 R7 w    Dim V As AcadView, D(2) As Double
* _9 l, C1 n2 n    With ThisDrawing
; _% ^. r1 w/ D5 s  Y        '新建视图" f2 v6 k% G9 k2 z/ b; T7 j5 C
        Set V = .Views.Add("AAA")
) D$ n6 K9 U$ v8 D7 d        '设置新视图的方向, o" `* d6 x! F2 S; d, `) y
        D(0) = -1: D(1) = -1: D(2) = 1" ~0 N# G! `" l6 f" l
        V.Direction = D
& I# ]3 U+ E+ Z! n$ T7 L        '活动视口设置为该视图- p: n( @; `" k
        .ActiveViewport.SetView V
: b$ I2 g  x# u! y; F( g2 Z# [        '重置活动视口& o+ z* I6 S5 {# \
        .ActiveViewport = .ActiveViewport
, K; Y8 `- Z% n) D    End With( u  ?6 }0 B. V0 b, l# G* e8 J
    '缩放视图
- N2 ~& E( ~1 D) H3 R$ r    ZoomAll* z1 S. b' w7 o( u, ]
End Sub
回复 支持 反对

举报

ning84
发表于 2009-7-21 09:03:18 | 显示全部楼层 来自： 中国甘肃兰州
找了很长时间,总算找到这个例子.2 g0 D; [! z' c3 R1 l- c% l. B9 ?
关键点3 [. G8 o" `$ I9 A" a
        P4(0) = 10: P4(1) = 0: P4(2) = 10& y' \6 W' a1 O( P1 v2 |) m
        '下面3个点用于定义新的UCS
8 J8 t& \. M. m        Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点; w& S# r, G8 W2 J: p
        Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向" e: D& v6 A7 G3 J9 o) e
        Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
7 k) Y- p8 Z0 {1 Z( @. }        '新建UCS
/ A5 G; Z# Z8 z* M        Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
回复 支持 反对

举报

发表回复
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

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