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

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

全站
11天前
查看: 3109|回复: 8
收起左侧

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

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

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

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

x
Dim object As AcadSolid
4 d! F5 t* X! e6 E( {$ kThisDrawing.SetVariable "fillmode", 1
' N) c* A0 G) \0 [$ H# tSet object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
/ |4 \; U% r. r, `3 robject.color = 66 i6 s4 N5 l# U- @6 i4 s
* _" |. I/ G/ U1 E1 M& k

3 ~2 P' _- e) d点已经定义好了。。只要这4个点是二维的。。就可以填充。。。但是如果点定义为三维的就不行。。
, G/ B8 O+ k0 d' V; L- {3 S7 d2 c+ z! o6 H6 E
高手指点！
回复

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 11:39:04 | 显示全部楼层 来自： 中国福建福州
那如何填充三维的面呢？
  X. E+ _8 a* A8 {' ?
+ T( _2 x6 N2 H( \3 N8 P+ [6 |  {1 G我这4个点是在XZ面上的一个四边形。。。5 E5 k+ m2 ]( q9 k1 M) F% f

: ?' q, F, m. p/ b0 _0 ^$ R$ r& [[ 本帖最后由 jjww123 于 2009-2-5 11:41 编辑 ]
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 13:53:50 | 显示全部楼层 来自： 中国辽宁营口
需要变换UCS) `* O% t8 `2 B
  1. ; N3 f! S* L& g! ~: z, l
  2. Sub A()
    ' d  W* |: z- H, ]$ P. X; G
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double1 y6 M6 c) T+ N/ Y, B- ]( R- T3 n0 e
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    9 d" ?* E: z6 P( e% v8 u; D# R9 E2 u" @
  5.     With ThisDrawing
    ! z6 n  v' r6 I. f& Z2 t
  6.         '下面4个点用于定义二维填充(solid)对象# l" _3 _: F( R  q; ?  m
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 05 |$ i* t; a% k! a1 X6 y+ F. _
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0
    . E  B1 d; `) ?7 I" T) I
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10; a+ y* H: D- x7 _  j
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10! i1 e- p% g8 z5 J: R
  11.         '下面3个点用于定义新的UCS) w" v6 ]' p6 O- d6 a( b
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点, j7 V7 O8 c0 f% ^
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
    : y4 b- m3 ]7 |! L' E& E
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    & G6 o' u6 I: S' U4 F  W8 d: Y
  15.         '新建UCS; L; r" h- ]6 E# @$ I3 M/ ]
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")2 h4 ^! Q( V. ^) \2 Q
  17.         '新UCS置为当前
    - U! f6 Y' d3 W/ n3 W2 w
  18.         .ActiveUCS = UCS
    % u; a; y+ @: I) P
  19.         '创建二维填充  h* M: d7 q- j/ Z- R
  20.         .ModelSpace.AddSolid P1, P2, P3, P40 i# ?# d# F. V1 Z% E( d0 M4 D( U0 _
  21.     End With1 C& a2 o' }+ U# n5 P
  22. End Sub
    % b7 N& A, [; D6 E
复制代码

) w" h! `+ W: Y2 p* `& k! i: s) |) H4 [1 F- X  z# e% D
上面代码中定义二维填充对象的四个点都是世界坐标系WCS。如果这四个点是自定义的用户坐标系UCS上的点，还需要换算坐标，参见下面的代码! z" D/ A. T3 H) Z/ h, I1 f1 L0 z+ T
  1. 9 i5 D) P* o' n1 l
  2. Sub A()+ j( r, s& j: S2 k& T) ]
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double8 l  `1 f9 c( |1 e# G' r! \9 d
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double' ]6 ^4 s1 ~0 P( H9 ?+ d1 E% b
  5.     With ThisDrawing" v7 h1 \3 a4 ^5 O" ^% Z2 n
  6.         '下面4个点（相对于XZ平面）用于定义二维填充(solid)对象# X7 Q7 U- l" S& s( R: P  k" O+ ]
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0# L$ n) A( r" h) _; v, b+ V8 I
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0
    * x/ D) F6 \; `' H% D+ }
  9.         P3(0) = 0: P3(1) = 10: P3(2) = 0
    " Z7 q- D! y/ i$ W
  10.         P4(0) = 10: P4(1) = 10: P4(2) = 0
    6 {7 u$ R6 g+ R- Z; v3 p3 E0 f
  11.         '下面3个点用于定义新的UCS
    ) ]2 Q! _1 M3 |- ~
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    1 X$ B+ e( @- d
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向6 v3 n) N& G2 A0 w4 k- x+ Y
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    0 D, Q8 F, T$ D" E/ D) I
  15.         '新建UCS2 w9 u% `1 x1 A: D% ]1 _6 }) G7 l
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    / T7 D: J$ G) l8 M" P- T  |0 t
  17.         '新UCS置为当前
    * U' x3 i3 m) k" d7 U
  18.         .ActiveUCS = UCS
    1 f! F) n. ^, e8 ~/ [  l: J8 e
  19.         '创建二维填充(P1和P2在两个坐标系中没有变化，不必换算；P3和P4从当前UCS换算为WCS才可以，因为addsolid方法的四个点坐标必须是WCS)* h! J/ _: N2 M
  20.         .ModelSpace.AddSolid P1, P2, .Utility.TranslateCoordinates(P3, acUCS, acWorld, False), .Utility.TranslateCoordinates(P4, acUCS, acWorld, False)7 q( U' L! f7 G3 H
  21.     End With: M% l* Y: U7 S- R* i, n" }
  22. End Sub* M! d) n$ \( z! N- H* j; p0 O
复制代码
回复 支持 反对

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 14:57:57 | 显示全部楼层 来自： 中国福建福州
版主您好！请问为什么画出来以后无法显示颜色。。必须要选视图-视觉样式-真实  以后才能显示填充以后的效果？: A9 Z- b7 x3 W6 S/ {

" N0 C! h* J% k" i/ M& C: t+ C. I8 n! {$ l
'下面3个点用于定义新的UCS# I+ _2 _. W7 u
    Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
! S5 L8 d6 z1 K( j# S6 U    Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
* r" A8 N) E  _    Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
4 M, ?. _4 w4 F. h
! _5 o7 C3 w- v4 P    '新建UCS) O$ b- a  A' b3 u
    Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
2 A! Y: `7 d, r% ?+ z8 f; r7 Y5 m    + C$ p) J  h5 Z; g
    '新UCS置为当前  J% ]. v9 n2 \% U5 g6 }+ u
    .ActiveUCS = UCS1 I8 T2 a  H# T
    . ~$ t9 y7 X: a$ p* H) j
    " T/ i$ s# M+ w, d- X1 q
    Dim object As AcadSolid2 v# |. P" t1 y/ |
   
" V, E  v& \8 {! {    Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)/ C: w; b2 ^/ v; X- F' W! v
    0 V0 P3 P( i( q( u1 p% m
    object.color = 6
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 16:38:26 | 显示全部楼层 来自： 中国辽宁营口
“FILLMODE”系统变量设置为1并且视图方向正对着二维实体时才能看到填充。
  u  _  w2 O- A; t- ?" T可以在上面的代码中再添加两行，如下
3 g" Q  w( w+ H1 y' _0 K

  1. . ^: S' W: b! @% [7 l, {) E
  2. Sub A()
    ( ^7 D$ T  j* R
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double+ l4 g4 N9 `! R) E
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double5 n5 O# n. x" m( _9 s+ k
  5.     With ThisDrawing
    1 p+ @3 G' u' o! o3 p$ L7 |
  6.         '下面4个点用于定义二维填充(solid)对象
    4 K# I: l8 P7 i7 \
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 09 u" }6 N; L) i
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0' G# L; b. _8 X9 |* w% T
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10
      k* J. [! h# m/ H
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10: D% k+ |5 q1 G# Z
  11.         '下面3个点用于定义新的UCS. d0 \9 {/ N# {! \9 W
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    ! o" ^. x6 r1 i$ @/ J
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向+ c) y1 ~( m2 A* M( W( n+ u! O
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向/ U. g$ _/ L- R, n* W
  15.         '新建UCS  C, B9 i) b' n+ T; r
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    3 ^! |2 y5 s# y4 M: P
  17.         '新UCS置为当前3 H! s- d/ y+ N% G" {/ F5 z
  18.         .ActiveUCS = UCS% o, C" _; \" d7 u/ b9 O
  19.         '创建二维填充
    $ H6 P- p: `$ X- a9 r9 @$ h/ h- C
  20.         .ModelSpace.AddSolid P1, P2, P3, P4& z% P4 p. ]8 q0 l+ ?
  21.         '发送键盘命令，使视图对正当前UCS。注意plan后面有两个半角空格，相当于两次回车
    $ N( r4 P% v! j4 p, s6 ?" X, l
  22.         SendCommand "plan  "
    9 I: U' q; J7 L
  23.         '修改系统变量（CAD默认该变量值就是1，如果没有修改过此变量，则此行可以不用）
    6 Q. F+ [- z7 p$ K. R3 g
  24.         .SetVariable "fillmode", 1' u* `# I8 {# I# s' q# w4 S
  25.     End With
    ( T  e% w) f7 @/ w& T; w
  26. End Sub
    ; h# ^8 \) I/ u2 W" G2 k
复制代码
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 17:09:42 | 显示全部楼层 来自： 中国福建福州
感谢版主耐心的回答。。$ T9 X' n9 K' \& d6 Y

) ?. ]9 U3 ]/ k) @2 ~/ x结合我另外一贴的问题。。加入以下代码以后。。视图是变了。。但是加上你上面填充的代码之后就乱了。。。
, [( H% D. R4 P. W7 ^6 u4 `. ]
% ?/ e8 y& l0 H8 v  X8 @如何在下面代码中添上楼上的填充代码。。并且正确显示呢？! ~" T, i( a3 Q3 s
9 V. F  Y$ v, e4 D7 {8 s
4 @) e. b" F. M! b8 T5 `
3 p, M! o1 Y* B2 _- P
Sub A()+ Q" x4 F4 M: e/ M- t
    Dim V As AcadView, D(2) As Double
0 T) u: ~' M0 ^8 }5 X. @9 d    With ThisDrawing
4 E3 l6 ^: Z5 \7 t6 m( K4 {        '新建视图& N3 \' b  l+ L; Y; W
        Set V = .Views.Add("AAA")
; I; l+ e4 y" j        '设置新视图的方向
- M$ g9 `8 \8 X3 q8 z! ^: G        D(0) = -1: D(1) = -1: D(2) = 1
3 M7 T" L, x2 _( R        V.Direction = D
9 m! z9 j2 L5 U& |) D8 _        '活动视口设置为该视图" A% g6 e! p& q' @3 k
        .ActiveViewport.SetView V
/ Q& ~3 k6 D9 \2 x& w        '重置活动视口# w1 Z) L) I1 v- F; u7 P
        .ActiveViewport = .ActiveViewport/ u! E% T) O8 o  s5 B' ^3 [% @
    End With+ x0 g( i# i+ W8 Y# d- q
    '缩放视图
) G, w, M. ^5 x& L$ P    ZoomAll7 `' o9 O$ Y0 d' b6 Q3 A. ~6 N. _
End Sub
回复 支持 反对

举报

ning84
发表于 2009-7-21 09:03:18 | 显示全部楼层 来自： 中国甘肃兰州
找了很长时间,总算找到这个例子.& }# M! q3 c/ F) U  B
关键点$ L0 j' B) s7 I) N3 n
        P4(0) = 10: P4(1) = 0: P4(2) = 10
1 n$ {3 F8 G# i/ Q        '下面3个点用于定义新的UCS* h/ {2 Q, o# c
        Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
" L! \6 \2 C1 \* d1 E. V( G        Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向) j* B3 S1 U) r
        Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
' u4 ]- t2 W) I1 x, b. G5 X( ~        '新建UCS: N7 I$ l3 `: F. N2 s
        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 )

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