VBA:如何填充不规则区域？

157787698

' w# l6 Q" t  Z- g% z# s0 R
如何填充不规则区域呢？比如下面的代码创建了一个封闭区域，如何填充呢？
( |' G9 W) [7 P% r6 {. I+ k
  

1. Dim splineObj As AcadSpline
   + I0 n% ]( P* C- B
2.     Dim startTan(0 To 2) As Double
   + ^* G# ?" L. w' W) m) f
3.     Dim endTan(0 To 2) As Double
   + ?0 j! T2 A3 T0 K7 J5 J
4.     Dim fitPoints(0 To 17) As Double
   1 P  t5 _' M; ?  X
5.     dim p2(0 to 3 )  as double
   5 Y! k1 I! L+ e) n% I8 s- ^+ t
6. 
   
7.     P2(0) = 1: P2(1) = 1
   3 J- y9 Z$ x; Y3 \
8.     P2(2) = 10: P2(3) = 1
   ) q% Q: C$ ]8 k+ ^% O& e1 V- Y7 t
9.     Set PLINEOBJ = ThisDrawing.ModelSpace.AddLightWeightPolyline(P2)
   
10. 
    
11.     startTan(0) = 0.5: startTan(1) = 0.5
    ; }$ Q3 h# L# Y. C' m
12.     endTan(0) = 0: endTan(1) = 0
    
13.     fitPoints(0) = 1: fitPoints(1) = 1
    / k: B. C% w9 p  q* E  y2 q( K
14.     fitPoints(3) = 3: fitPoints(4) = 9
    
15.     fitPoints(6) = -1: fitPoints(7) = 17
    ; k5 ~& @  {9 r1 {% u& b/ U, M( P* M
16.     fitPoints(9) = 1: fitPoints(10) = 25
    ! [6 X& f# k7 W8 s
17.     fitPoints(12) = 10: fitPoints(13) = 10
    ' _) L. Q# r+ c. L! v
18.     fitPoints(15) = 10: fitPoints(16) = 1
    
19.    
    2 B3 N" N! B" h9 a$ q: W
20.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    
21.     ZoomAll
    # I7 X( I2 R& |% H4 U3 e
22. 
    

复制代码

; q7 X: V9 E: d如何使用取点填充？

woaishuijia

1.     Dim splineObj As AcadSpline
     ]/ i9 j1 }2 a$ `1 N+ _& ^- t
2.     Dim startTan(0 To 2) As Double
   
3.     Dim endTan(0 To 2) As Double
   
4.     Dim fitPoints(0 To 17) As Double
   ( t9 i4 j6 f# h% ^9 P4 \
5.     Dim p2(0 To 3)   As Double
   
6.     Dim PLINEOBJ As AcadLWPolyline
   % h2 Q3 g! \, b( O
7.     '声明一个对象数组,用于定义填充的外边界
   / o  o  j. }) B+ I* k! |1 ~
8.     '边界必须是由同一平面内首尾相连的若干条线封闭构成
   2 r) B( F- p, O+ P8 q
9.     '本例的填充边界由一条二维多段线和一条二维样条曲线共两条线构成,所以数组元素数为2,最大下标为1
   : b$ o5 Z8 q3 w8 G, x
10.     '根据需要,还可以声明若干个对象数组用于定义填充对象的内边界
    ! q# M1 ]% G* X8 s
11.     Dim Obj(1) As Object
    * d( v0 \1 t. h
12.     '声明一个填充对象
    
13.     Dim H As AcadHatch
      ?: H# c4 t, Q2 R& W
14.    
    
15.     p2(0) = 1: p2(1) = 1
    
16.     p2(2) = 10: p2(3) = 1
    6 ]1 J0 m, G" a, l+ O
17.     Set PLINEOBJ = ThisDrawing.ModelSpace.AddLightWeightPolyline(p2)
    + P4 j; W, m; _: n% _
18. 
    
19.     startTan(0) = 0.5: startTan(1) = 0.5
    4 d; o; d3 [! k+ G! c
20.     endTan(0) = 0: endTan(1) = 0
    ! D: U# H6 K. L) b- _
21.     fitPoints(0) = 1: fitPoints(1) = 1
    4 m/ \$ X0 {# F$ X. ?1 _
22.     fitPoints(3) = 3: fitPoints(4) = 9
    7 a9 ^6 R2 L) ~1 u; M
23.     fitPoints(6) = -1: fitPoints(7) = 17
    
24.     fitPoints(9) = 1: fitPoints(10) = 25
    2 z7 W# e/ m, D
25.     fitPoints(12) = 10: fitPoints(13) = 10
    ) V5 x/ r2 ?4 r% C- P% S3 ~7 P
26.     fitPoints(15) = 10: fitPoints(16) = 1
    * {* ^( z. B8 C+ J. _3 x
27.    
    
28.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    
29.     '对构成边界的数组赋值
    5 r. D$ d% @: j6 Y* I
30.     Set Obj(0) = splineObj
    
31.     Set Obj(1) = PLINEOBJ
    
32.     '创建填充对象
    0 s3 h7 n  r) M1 s& a( s
33.     'cad2004及以上版本的AddHatch方法既可以创建图案填充,也可以创建渐变色填充
    5 A, l: W& Z- u2 v; Z8 S
34.     '所以2002及以前版本的AddHatch方法有三个参数,而2004及以上版本增加了第四个参数"填充对象类型"(AcHatchObjectType)
    5 m4 C9 W* Z# l9 O1 Y6 v2 n
35.         '该参数有两个命名常量,一个是acHatchObject = 0(图案填充),另一个是acGradientObject = 1(渐变色填充)
    7 b5 `( P. q% \: e# k5 n/ w4 f
36.         '该参数是可选的,默认是0(即图案填充)
    4 C. W4 g6 t" u
37.         '下面的代码没有写这个参数,用的是默认值图案填充
    
38.     '前面三个参数:
    
39.         '当填充类型为图案填充时
    : S& L9 X4 i( Y
40.             '第一个参数是"图案类型"(AcPatternType)
    
41.                 '该参数有三个命名常量
    
42.                     '一个是acHatchPatternTypeUserDefined = 0,对应于图形界面填充对话框中"类型"下拉列表框中的"用户定义"
    
43.                     '再一个acHatchPatternTypePreDefined = 1,对应于图形界面填充对话框中"类型"下拉列表框中的"预定义"
    " }7 @7 b, M* h
44.                     '第三个acHatchPatternTypeCustomDefined = 2,对应于图形界面填充对话框中"类型"下拉列表框中的"自定义"
    
45.                     '下面的代码用的是"预定义"
    % Y& T9 c9 y0 @
46.             '第二个参数是"图案名称",在图形界面的填充对话框中都可以看到
    
47.         '当填充类型为渐变色填充时
    
48.             '第一个参数是"渐变类型"(AcGradientPatternType)
    
49.                 '该参数有两个命名常量
    5 g' ?9 ]7 H+ z! U! A# I
50.                     '一个是acPreDefinedGradient = 0(预定义)
    
51.                     '另一个是acUserDefinedGradient = 1(用户定义)
    
52.                     '第二个可能是为以后版本升级备用的,现在不能用,只能用第一个
    
53.             '第二个参数是"渐变填充名称",预定义的有以下这些
    3 U% ~: o! i% I6 M; [6 D: B) L7 c
54.             'LINEAR, CYLINDER, INVCYLINDER, SPHERICAL HEMISPHERICAL, CURVED, INVSPHERICAL, INVHEMISPHERICAL 或 INVCURVED
    ; r: m+ ~1 U  s9 o8 m! l
55.         '第三个参数是"关联",布尔型
    
56.     Set H = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "ansi31", True)
    
57.     '创建填充后的第一件事就是为它指定外边界
    0 v8 K" ?/ f; v& h, O7 o% d
58.     '填充对象的其它属性可以在后面慢慢弄,这里就不写了
    
59.     H.AppendOuterLoop Obj
      _: M$ x* V( f9 d
60.    
    ' G' f: V8 V0 `, R
61.     ZoomAll

复制代码

157787698

谢谢
/ t" Z' }! B- c
! S) n+ W( h. q2 |6 d* t! K9 [% Y我爱谁家，你太强了

157787698

需要补充说明一点：
绘制样条曲线时最好用三维坐标，即z坐标即使为0也写出来

. E& i. z' k7 M我遇到了这样一个问题：我在填充由样条曲线和多线段围成的区域时，经常跳出来提示输入无效，但有时候又是正常的。
! v) B9 w; v4 s: x9 r2 E0 P
我查找了很长时间，我觉得这没有道理。
# B$ ^6 _# R. H& m+ z
( O6 T# e4 W! x5 n0 @, l1 ]6 ?最后发现是因为我在绘制多线段时使用了绘制样条曲线时的同一个数组导致的，而在那里使用该数组的时候我是当做二位坐标来赋值的，而在对样条曲线点赋值的时候我直接忽略了z坐标，导致样条曲线不在xy平面上，最终形成的区域不是二维面域，也就无法填充。