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

QQ登录

只需一步，快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步，快速开始

返回
发新贴
展开

通知     

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

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

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

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

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

x
Dim object As AcadSolid
# \9 s$ f9 N+ N7 \6 gThisDrawing.SetVariable "fillmode", 1; P9 I, K1 j: D) ~9 p# ~0 Z/ t
Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
2 J% c! l2 [0 o5 lobject.color = 6  f4 }, y3 `3 X  f" ~
7 I1 m9 q/ K2 @; `

& X# S/ Z& T+ X- m( V- X点已经定义好了。。只要这4个点是二维的。。就可以填充。。。但是如果点定义为三维的就不行。。
: B. v( z/ T0 a  x
! A6 i" I* ~0 f$ b4 m高手指点！
回复

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 11:39:04 | 显示全部楼层 来自： 中国福建福州
那如何填充三维的面呢？
1 p4 w5 ?0 ~  q, t8 S' T
$ i3 w  N- f* B3 h4 H0 ~# i) `我这4个点是在XZ面上的一个四边形。。。
$ R3 L0 i9 {( ]) m' e7 X- [& L  r" w# w7 H7 y0 ~# c" B1 P
[ 本帖最后由 jjww123 于 2009-2-5 11:41 编辑 ]
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 13:53:50 | 显示全部楼层 来自： 中国辽宁营口
需要变换UCS, D( F% L/ r# X- p- v9 T# F

  1. - ^& E; b% R9 n9 t
  2. Sub A()3 O( W. ]8 v# h
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
    : ?$ V. J0 m* C- L6 q2 J
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    0 t. W9 p" c$ n% V! d1 n; B) l) B. h
  5.     With ThisDrawing7 o/ r) b4 m( A" n
  6.         '下面4个点用于定义二维填充(solid)对象7 X, X( \% n* s/ N3 d# q( f4 L
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0
    : F& V. W0 j  H7 {
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 06 I* D) |5 k8 C0 Q$ C
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10
    & z7 _/ W! l; B4 M, w& f: E/ j8 \
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10
    9 G; ~/ o5 m4 [' b
  11.         '下面3个点用于定义新的UCS
    # u/ ?: V) z- }& I
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    ' q! W2 e! a  @4 R: b+ J1 O' }' [$ R. w
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
    7 R& Y1 f- M' w. f) v9 v
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    ' e) Q8 v7 {1 s
  15.         '新建UCS
    : Z* D" w" y2 g3 C% c
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")6 S% @: Q3 D! r( L& V) h* A) c9 R
  17.         '新UCS置为当前/ w/ @; A/ M6 q  l& J. M8 U
  18.         .ActiveUCS = UCS
    3 T4 h4 X) x. T3 k
  19.         '创建二维填充
    . P  y' q% ?+ Q0 Q: N; v
  20.         .ModelSpace.AddSolid P1, P2, P3, P40 N' B) l1 _' i
  21.     End With. x7 O- N8 _  J# j" x. f
  22. End Sub
    3 B, d  w4 {' M: y
复制代码

& Y# u/ U* A$ ]5 L! M8 c' B, `8 m4 C! N$ m/ g' w
上面代码中定义二维填充对象的四个点都是世界坐标系WCS。如果这四个点是自定义的用户坐标系UCS上的点，还需要换算坐标，参见下面的代码
5 B/ w6 Q' I+ f& C. x* k

  1. + D' x% E4 k$ Q
  2. Sub A()' `9 s4 k, M. ]8 D  A3 Q
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
    6 d5 W3 H& \$ R0 D9 H1 r
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    : d1 Y! |7 ?& y+ G
  5.     With ThisDrawing& ~: ]3 z5 z+ |1 J0 {' R  [
  6.         '下面4个点（相对于XZ平面）用于定义二维填充(solid)对象' O! T7 o: X% l# Y# g7 d4 t8 j
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0, t! J( e2 u1 P9 O. K; @
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0- a! {5 \; p8 {. w6 k
  9.         P3(0) = 0: P3(1) = 10: P3(2) = 0
    ) _  u  W# E+ b( ]
  10.         P4(0) = 10: P4(1) = 10: P4(2) = 0
    . I8 _# G1 W* I7 a! N0 x- ~3 g+ y7 A
  11.         '下面3个点用于定义新的UCS
      p8 i5 n* n0 k+ M& Z
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
    ( M3 a4 b3 O6 I( y
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向  ~. ?- x/ Z, x& x
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向6 e4 n7 n1 q2 m
  15.         '新建UCS
    1 d. g3 z5 h0 T2 F' H% T
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA"): w( k- ]/ k; Y
  17.         '新UCS置为当前
    2 g' M& e2 B/ X2 Y. b% J
  18.         .ActiveUCS = UCS/ b9 C4 k5 l1 X/ J9 {
  19.         '创建二维填充(P1和P2在两个坐标系中没有变化，不必换算；P3和P4从当前UCS换算为WCS才可以，因为addsolid方法的四个点坐标必须是WCS), \2 X* M* C- ]% d$ I# h$ Y
  20.         .ModelSpace.AddSolid P1, P2, .Utility.TranslateCoordinates(P3, acUCS, acWorld, False), .Utility.TranslateCoordinates(P4, acUCS, acWorld, False)+ \/ T: z! n5 Z& @; g; n
  21.     End With; c+ h' |% d! l6 p. |& M
  22. End Sub) B# {9 K3 F. `  d# Y- R
复制代码
回复 支持 反对

举报

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

举报

jjww123
 楼主| 发表于 2009-2-5 14:57:57 | 显示全部楼层 来自： 中国福建福州
版主您好！请问为什么画出来以后无法显示颜色。。必须要选视图-视觉样式-真实  以后才能显示填充以后的效果？
6 W/ M+ i) H! i7 z* i' Z  L6 \
8 Q& q5 e, y2 i; p8 h, o2 a# o* I0 _/ G  k, R: b
'下面3个点用于定义新的UCS
+ A  j: D7 g2 F& f$ L- v, z! ^    Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点7 Z  C( i$ J9 v; J
    Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向  [9 Z3 ?3 Q% e3 n8 w+ G
    Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向; O% O9 ?1 _, A8 Z) E

$ v1 m4 v# z' F+ A& `) Q" ]7 f    '新建UCS% j9 _% Z) q; T( R5 F2 G- s
    Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
+ h4 z8 X6 S- a: z   
* a% E' m- X) `( z* [  K0 a3 ?* q    '新UCS置为当前) k; w- P5 l8 w0 V6 c& D$ w
    .ActiveUCS = UCS
7 S# S$ p6 C% P3 S  ~4 x    ! i6 L# C" ?0 c& X
    " _5 b: o' g$ j- C
    Dim object As AcadSolid
' a  g; P( D3 f7 O    8 V' J' @5 z6 w) i$ n2 E
    Set object = ThisDrawing.ModelSpace.AddSolid(e点, f点, h点, g点)
9 [/ i& m; g3 o  j) H    / D% q" c9 d4 N6 m2 P* J( V
    object.color = 6
回复 支持 反对

举报

woaishuijia
发表于 2009-2-5 16:38:26 | 显示全部楼层 来自： 中国辽宁营口
“FILLMODE”系统变量设置为1并且视图方向正对着二维实体时才能看到填充。0 I6 O& f+ Y3 Z" ?
可以在上面的代码中再添加两行，如下
9 q! f* G" a1 Y
  1. 5 l1 P) U9 Z. R- L
  2. Sub A()0 [7 d2 R, d9 ]/ W) \
  3.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, P4(2) As Double
    $ O" ~3 q3 v3 P
  4.     Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
    9 D* V! G5 W  \3 e; ~2 _; j
  5.     With ThisDrawing
    ' l- f# k. n1 D5 W( h
  6.         '下面4个点用于定义二维填充(solid)对象
    ' d0 F; @4 I0 k8 T6 Y1 z
  7.         P1(0) = 0: P1(1) = 0: P1(2) = 0+ s. `+ a" w6 m& C( B
  8.         P2(0) = 10: P2(1) = 0: P2(2) = 0
    6 R1 O! r& `0 o- `5 z
  9.         P3(0) = 0: P3(1) = 0: P3(2) = 10
    % i% h- I0 d6 @% s
  10.         P4(0) = 10: P4(1) = 0: P4(2) = 10" l0 H7 i0 w. ^. o9 K' r6 e
  11.         '下面3个点用于定义新的UCS; b$ h5 [8 n* k) I9 ?5 j4 A) ]& \
  12.         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点/ v; t* h1 M* k; a, `
  13.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
    + ~7 B, e4 N5 T. C5 b! A- c) x4 A( e& s
  14.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
    ' a: H* w/ R) I3 S8 y
  15.         '新建UCS
    2 Z" c1 Q* n% ?: V
  16.         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")( U! r6 y  `- ^! F( N+ l% s  W
  17.         '新UCS置为当前) b, e0 D% o5 h
  18.         .ActiveUCS = UCS
      T) ?; f  U! {/ `$ H5 R1 \: R! B
  19.         '创建二维填充$ c1 h, s. F. K" Z: _
  20.         .ModelSpace.AddSolid P1, P2, P3, P4$ t6 Q, y' l' S8 A$ A
  21.         '发送键盘命令，使视图对正当前UCS。注意plan后面有两个半角空格，相当于两次回车9 L  F/ ?% M+ ^  p/ \2 A: W
  22.         SendCommand "plan  "+ G0 I* a6 ~% o% @" U+ `
  23.         '修改系统变量（CAD默认该变量值就是1，如果没有修改过此变量，则此行可以不用）  h) u6 u; u0 ^' B  g; C
  24.         .SetVariable "fillmode", 17 ^) n! B& C5 M( n: A% M
  25.     End With. {0 {7 Y2 `; h
  26. End Sub3 U8 ~- C5 }- a7 \* l& r- k! j
复制代码
回复 支持 反对

举报

jjww123
 楼主| 发表于 2009-2-5 17:09:42 | 显示全部楼层 来自： 中国福建福州
感谢版主耐心的回答。。
& [: d2 o# [  B2 {' m- s; @/ i1 g$ r7 G3 x$ J
结合我另外一贴的问题。。加入以下代码以后。。视图是变了。。但是加上你上面填充的代码之后就乱了。。。  W$ T  J' A# S9 k% i5 V

  B' R0 F1 @+ s0 t4 [4 {, ]; L如何在下面代码中添上楼上的填充代码。。并且正确显示呢？, p$ S4 {3 M1 H2 }* S2 \) w& G

5 h, }$ \; Y3 e, R7 K, Q# k" E( o- }+ m- z
) A; T' @" ~5 m6 D" ~
Sub A()
/ p" X) a1 x* W' Y# I+ }0 _    Dim V As AcadView, D(2) As Double" x2 d9 ]: D  w0 v# |# \5 {
    With ThisDrawing& o# o2 P! q1 J! @
        '新建视图8 {/ j6 c2 P) S1 _% A
        Set V = .Views.Add("AAA")+ A$ K' S7 V! N( Q$ I- S/ Q
        '设置新视图的方向* d. o1 P- e7 L0 ]0 l& ~2 j. e
        D(0) = -1: D(1) = -1: D(2) = 1
6 ~, X  J) Z/ i% D5 ?, f        V.Direction = D
) e! @2 ]( M5 r2 i, L        '活动视口设置为该视图6 @3 U9 |5 x* [. e9 K  `) n2 H
        .ActiveViewport.SetView V5 T5 S$ c2 T4 W/ C/ ^
        '重置活动视口
+ u* ^; R; }) Y" H% J0 ^0 l        .ActiveViewport = .ActiveViewport
& v; W5 |; x* R' X* ]3 d1 {% W    End With+ z0 O) A/ w" v
    '缩放视图5 h: _. z  y9 B  a( w2 N
    ZoomAll
; ?" M5 R. T& l$ }* YEnd Sub
回复 支持 反对

举报

ning84
发表于 2009-7-21 09:03:18 | 显示全部楼层 来自： 中国甘肃兰州
找了很长时间,总算找到这个例子.
, f" A& e8 l9 E' c1 o关键点
! |. z5 E9 w# }        P4(0) = 10: P4(1) = 0: P4(2) = 10: c' _8 Q: G1 m. \2 y
        '下面3个点用于定义新的UCS
* x& Z4 s4 R5 b        Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点8 {6 \! [, `" H
        Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向2 ^$ o1 ^# _5 y* V# O  h' }
        Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
$ h0 Q  T& d" e/ o        '新建UCS
; l/ [/ y. e) T7 S$ r# Y        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 )

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