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

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

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

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

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

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

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

x
Dim object As AcadSolid' s. {1 ]) @; F5 H
ThisDrawing.SetVariable "fillmode", 1
' f9 ?$ u: S2 Q3 Q2 lSet object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)8 S9 G, k: J9 O6 ~; Y
object.color = 6
3 a4 o$ P7 D: L* ~3 X  ?5 C
, a6 q. [$ h) r+ H6 G
1 Y) _3 D9 \% q' g. r1 s% s点已经定义好了。。只要这4个点是二维的。。就可以填充。。。但是如果点定义为三维的就不行。。- `) `% U# p. m9 n3 F% u% J$ w

( X! U7 F+ D. Z5 u5 l1 G6 q) {* W$ P高手指点！
回复

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 11:39:04 | 显示全部楼层 来自： 中国福建福州
那如何填充三维的面呢？
( K# }3 P7 q/ Y& S$ X1 g
- w0 q8 j7 l% v, u6 Z: Z" |我这4个点是在XZ面上的一个四边形。。。
6 N7 J* O% W) p0 R: Z$ M
* d) E1 a1 R) l[ 本帖最后由 jjww123 于 2009-2-5 11:41 编辑 ]
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 13:53:50 | 显示全部楼层 来自： 中国辽宁营口
需要变换UCS6 U; l4 X5 G: {: ~3 |, X
  1. % w0 `. f5 ~3 E; b- }' t5 a; I
  2. Sub A()6 M, W3 f' a& h# o( a
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double; A; o" H1 A; r! X
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double1 |- K# `6 {& b4 w9 h4 p6 W
  5.     With ThisDrawing
    . ~( d4 h. |3 I: g3 k9 ?
  6.         '下面4个点用于定义二维填充(solid)对象: G. S+ c) g. O# L# Q$ |
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0% I8 i7 w8 s( l: z2 ~! X
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0, L8 {, Z  ]& U" o
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10
    , f6 J2 N) x( ]8 B' s
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 104 h8 y! e  g9 O# q( q
  11.         '下面3个点用于定义新的UCS/ M3 }  t* G  @( D
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点& r/ x- O  ^3 w! M% S3 k$ B
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向$ G6 x/ \4 R* r0 S4 l' V) c8 ?
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向5 a' u- G+ W( X( }
  15.         '新建UCS) M! b/ d) }, M" F' x5 w
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
    8 p) l' Y9 o  d8 A6 K+ H. O
  17.         '新UCS置为当前' I- c  d) Y. O) c4 j! d: b& Q
  18.         .ActiveUCS = UCS/ o" \5 @# |7 J5 ]
  19.         '创建二维填充
    ! r- U) I) {4 R' R: [
  20.         .ModelSpace.AddSolid P1, P2, P3, P4* u( o) B: f9 F& Z; ?
  21.     End With
    ' S1 u7 @; f9 i( }9 ]& k
  22. End Sub6 f; V1 P) ?9 r( b, X
复制代码

* t8 C( |+ z1 i+ m4 I5 [* }2 Y4 |5 ^8 S, j' E  `
上面代码中定义二维填充对象的四个点都是世界坐标系WCS。如果这四个点是自定义的用户坐标系UCS上的点，还需要换算坐标，参见下面的代码' b* O, r6 F. x8 F- t
  1. , X' Y. U- A9 j+ D
  2. Sub A()
    - Q& f( s: `' _' n7 Q
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
    ! H  `& B4 X6 Q; e1 n
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    5 h0 ^* `) y, r5 V/ L
  5.     With ThisDrawing) j% |2 Z) [7 o4 D" v% k8 r- J
  6.         '下面4个点（相对于XZ平面）用于定义二维填充(solid)对象3 d9 ?; }& Q% h9 S
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0
    . h4 }! @7 Z6 _  q
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0# ~6 G* c6 h4 _9 k7 P
  9.         P3(0) = 0: P3(1) = 10: P3(2) = 0- X- e* J. D( h
  10.         P4(0) = 10: P4(1) = 10: P4(2) = 0
    % x3 O: u+ d7 n% P
  11.         '下面3个点用于定义新的UCS8 m2 }7 c# l3 y; s4 b. i
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点! O% n8 V8 B: n; |8 P
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向/ j! z1 P- a( B8 T
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    ! J5 ~* L1 i( m9 V* R7 c0 Z! C$ r) W8 Z# w
  15.         '新建UCS$ [4 R4 M* s( T% `
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")" X' w  U/ N% C
  17.         '新UCS置为当前
    5 N$ f3 z7 N5 K  V
  18.         .ActiveUCS = UCS
    & ~5 s8 l; x: v5 b$ N! n
  19.         '创建二维填充(P1和P2在两个坐标系中没有变化，不必换算；P3和P4从当前UCS换算为WCS才可以，因为addsolid方法的四个点坐标必须是WCS)
    ; ]: R, {+ _( |1 C5 X
  20.         .ModelSpace.AddSolid P1, P2, .Utility.TranslateCoordinates(P3, acUCS, acWorld, False), .Utility.TranslateCoordinates(P4, acUCS, acWorld, False)
    0 D; F" M8 O: B$ ]; k! c
  21.     End With9 [$ L! ~: u$ X6 |6 }
  22. End Sub+ M% j. i! M3 ~* r( k' d  C
复制代码
回复 支持 反对

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 14:57:57 | 显示全部楼层 来自： 中国福建福州
版主您好！请问为什么画出来以后无法显示颜色。。必须要选视图-视觉样式-真实  以后才能显示填充以后的效果？
! o" N' n& ~/ `; _6 q8 ?. o/ w+ w4 x+ s

) v& L6 Q* ]" Z1 Z" f '下面3个点用于定义新的UCS* [3 R; a. h: @* V# E# J6 X# |$ Y
    Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点* Y7 c; m; W) t- D, E
    Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向+ t0 `$ R# K( V2 ^: O% U
    Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向" O/ p4 A' r2 ?9 m* v' ^' T- `
4 J( V/ b, _# U; E' P/ Z
    '新建UCS
2 A9 p: s9 T1 A; k    Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
3 q3 H' b* Z) P3 d0 X% w: m    - m! o! b- q5 X$ z9 R
    '新UCS置为当前
% J8 c8 R  Q9 U* g) x    .ActiveUCS = UCS
  u+ ?' J7 l4 {# I; Y! q   
! k- T6 t. m7 O    8 E6 R. E" v, J7 c
    Dim object As AcadSolid
2 p5 k! Z; s3 j/ }0 b$ |  V9 ^    * R+ P" w& B4 w, D7 k$ B
    Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
7 G9 ~$ W$ p5 P5 U. A4 }; \   
5 h8 [- L$ v+ M5 f9 G* T; }    object.color = 6
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 16:38:26 | 显示全部楼层 来自： 中国辽宁营口
“FILLMODE”系统变量设置为1并且视图方向正对着二维实体时才能看到填充。
( Z1 @7 C. c  h8 S; O可以在上面的代码中再添加两行，如下( B- b9 B: u& A" N8 y# L

  1. ( `  k7 V) |8 c, i2 X- k0 C
  2. Sub A()
    " E5 i: x% e, ^% U) n% P
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
    # D' |/ J. y' X
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    & i: p2 N- h; Q& Z* Z6 v$ I( C6 L
  5.     With ThisDrawing
    " H7 ~7 C* ]5 L4 M, z# h
  6.         '下面4个点用于定义二维填充(solid)对象
    . G% K/ D! T) \7 d, {
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0; w3 m; g0 t. I$ ~  v
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0  H, O# H" m8 W7 I# @9 I
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10& p; \$ w* E/ ]& C; e
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10
    8 t- a, I/ e* A
  11.         '下面3个点用于定义新的UCS, B: f; ^- q/ I5 Y7 b
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    + M/ ?2 a( G! F9 S
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向$ K& B/ S* z- g, s
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    5 X5 q5 ]" f$ h: V# B- }0 G* |
  15.         '新建UCS3 {) p6 d, {( v$ `. a3 K. ~# u8 U
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA"): }* a  [# J/ E+ K
  17.         '新UCS置为当前
    0 D, {. b7 _. D
  18.         .ActiveUCS = UCS$ ^. Z/ G7 @" b2 {: @0 ~
  19.         '创建二维填充
    " L+ G) m) u5 f$ O" x$ o+ t
  20.         .ModelSpace.AddSolid P1, P2, P3, P4
    3 L6 z5 d0 N1 s: P. F. W
  21.         '发送键盘命令，使视图对正当前UCS。注意plan后面有两个半角空格，相当于两次回车
    / G5 h3 l# ^/ z- E
  22.         SendCommand "plan  "" ?1 O  l$ B2 A: ?. R0 G" ~
  23.         '修改系统变量（CAD默认该变量值就是1，如果没有修改过此变量，则此行可以不用）
    8 o+ Q: H  x! |% r
  24.         .SetVariable "fillmode", 18 U$ `) y( z! e$ v5 o9 C" h( v
  25.     End With
    ; B' L% b( b- n5 H
  26. End Sub: i1 @/ d2 _% T; [3 B  J
复制代码
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 17:09:42 | 显示全部楼层 来自： 中国福建福州
感谢版主耐心的回答。。
" j* \0 h/ L9 R2 Y0 n( P' E8 r( D" q
结合我另外一贴的问题。。加入以下代码以后。。视图是变了。。但是加上你上面填充的代码之后就乱了。。。7 H& m% X( g) h) H1 s2 M

" n, l9 h6 b$ ^3 D. n7 o. }" f' |如何在下面代码中添上楼上的填充代码。。并且正确显示呢？
& m- v% `; Z  b. G
; X, y& ?8 U- J) L
& q, j3 h7 d& G& B3 r. `8 [' ^
! \, S) E) l+ c! h+ T0 YSub A()
' h. [9 @$ Q: k' j    Dim V As AcadView, D(2) As Double2 k9 K. D& t0 s! I" T0 C8 o7 R
    With ThisDrawing( N' Z, t' M9 ^3 i* F5 V) m
        '新建视图" c8 q, I1 i; b+ Q0 M, |6 g/ h' r
        Set V = .Views.Add("AAA")
/ @2 \2 s3 ]. Y4 N7 f        '设置新视图的方向- V/ b9 @8 n" V. Z$ j, G, A
        D(0) = -1: D(1) = -1: D(2) = 1
3 W$ J7 X( c7 ^+ e" p6 Y        V.Direction = D8 r6 `  T9 j1 X$ ]
        '活动视口设置为该视图
7 y3 J) w4 t$ z! x2 E7 K* G        .ActiveViewport.SetView V* j6 q8 t, {5 v& }: m  F
        '重置活动视口
+ ?+ l9 n5 d. S        .ActiveViewport = .ActiveViewport. V# g& X, K0 V+ B  d: o
    End With. I/ h6 D* t* I
    '缩放视图
" n+ [1 S* \% G; v3 w: V- d! U    ZoomAll5 |2 v0 G4 z6 f
End Sub
回复 支持 反对

举报

ning84
发表于 2009-7-21 09:03:18 | 显示全部楼层 来自： 中国甘肃兰州
找了很长时间,总算找到这个例子.
/ N( o7 [7 l- k3 j$ ^! c  S5 U关键点
1 `4 h5 V0 t: k8 T! F        P4(0) = 10: P4(1) = 0: P4(2) = 10* I" p- m$ D' G& M% A2 ?6 U) Q
        '下面3个点用于定义新的UCS
5 p) a: [/ G0 E2 A3 k6 h! ?        Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
$ K( b; i. K5 F; r5 o6 d. Q2 n* {        Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
) y5 j8 ~6 \2 x( o        Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
! d2 @5 F8 w5 f1 h$ k! v  E1 r        '新建UCS
7 l( c6 p6 t& A# G4 u& A        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 )

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