能不能用VBA把下面2个图帮我做一下

ghostcheng

请哪为高人 能不能把下面2个图帮我做一下可以吗？

ghostcheng

要求是用VBA  编码 做的    我先谢谢了。

woaishuijia

第一个图
* ^& Z, E3 X. _& M2 k

1. 
   
2. Sub A()
   
3.     Dim PL(0) As AcadLWPolyline, Ps(17) As Double, R As Variant, P(2) As Double, D(2) As Double
   
4.     With ThisDrawing
   
5.    
   ) N5 s5 V5 _$ P  K7 i% M, r. |
6.         '转换到世界坐标系WCS
   
7.         SendCommand "ucs w "
   
8.         
   
9.         '定义优化多段线的顶点坐标
   
10.         Ps(0) = 30: Ps(1) = 0
    5 I6 ?& I% Z$ X( C' D3 n
11.         Ps(2) = 100: Ps(3) = 0
    + h& T6 h8 I* x" Q% ^
12.         Ps(4) = 100: Ps(5) = 25
    
13.         Ps(6) = 95: Ps(7) = 30
    
14.         Ps(8) = 65: Ps(9) = 30
    
15.         Ps(10) = 60: Ps(11) = 35
    ( y; n/ N) Q) A0 Q6 N
16.         Ps(12) = 60: Ps(13) = 95
    / `7 S; F# Q. ^9 X
17.         Ps(14) = 55: Ps(15) = 100
    # L& f5 |, X8 H0 N+ b
18.         Ps(16) = 30: Ps(17) = 100
    
19.         
    " Y* d* x6 l& l/ Z0 U
20.         '创建优化多段线
    ! q/ c6 O: G3 `/ W
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    % M% f+ O, i  j, v$ q5 v
22.         
    
23.         '多段线闭合
    
24.         PL(0).Closed = True
    $ U) M1 J+ @' T; ]* h0 @
25.         
    1 ^( @% q" O6 l2 M3 ]4 q
26.         '多段线第3、4顶点间部分改为90度圆弧
      U$ h7 E3 M5 Y7 o0 T
27.         PL(0).SetBulge 2, Tan(.Utility.AngleToReal(22.5, acDegrees))
    
28.         
    
29.         '多段线第5、6顶点间部分改为90度凹进圆弧
    0 O% J  R' v+ z5 z, W
30.         PL(0).SetBulge 4, -Tan(.Utility.AngleToReal(22.5, acDegrees))
    + h, s0 c" T$ s3 T" n& K+ C! L4 Z6 d
31.         
    
32.         '多段线第7、8顶点间部分改为90度圆弧
    
33.         PL(0).SetBulge 6, Tan(.Utility.AngleToReal(22.5, acDegrees))
    
34.         
    ) ?9 y+ t  E# |6 p  d
35.         '用多段线做面域
    2 v0 o  p% p6 D8 G" R
36.         R = .ModelSpace.AddRegion(PL)
    . M- v+ E+ _4 P) H
37.         
    ) u3 V! p" @" O1 r/ a; q6 v# G8 Q
38.         '定义旋转轴起点
      _# M' Q5 A' {% ~
39.         P(0) = 0: P(1) = 0: P(2) = 0
    6 H8 @$ Y: A3 t2 I4 y3 b# l
40.         
    $ V& @, T0 ]6 g6 Y7 z1 y
41.         '定义旋转轴方向
    
42.         D(0) = 0: D(1) = 1: D(2) = 0
    * Y9 i3 e& X4 y
43.         
    $ G" B" |0 V/ @
44.         '旋转360度建模
    4 ]8 P) I  \0 U
45.         .ModelSpace.AddRevolvedSolid R(0), P, D, .Utility.AngleToReal(180, acDegrees) * 2
    
46.     End With
    5 X  E8 K" E9 x
47. End Sub
    9 a7 G  D. P$ p2 ?

复制代码

0 ]4 X3 O& i% _, d% ^. l/ V[ 本帖最后由 woaishuijia 于 2009-2-7 20:49 编辑 ]

woaishuijia

第二个图

1. 
   
2. Sub A()
   
3.     Dim PL(0) As AcadLWPolyline, Ps(11) As Double, C(0) As AcadCircle, P(2) As Double
   
4.     Dim R1 As Variant, R2 As AcadRegion
     M8 F4 a; G" ?- E
5.     Dim S1 As Acad3DSolid, S2 As Acad3DSolid
   
6.     Dim UCS As AcadUCS, Xp(2) As Double, Yp(2) As Double
   ; E6 x7 ~( u0 @- T) M0 w
7.     With ThisDrawing
   
8.    
   + b* l( N8 E8 w& d: g# t" ]0 D+ I" j$ V
9.         '转换到世界坐标系WCS
   
10.         SendCommand "ucs w "
    % t, j, |8 P; o4 Y: O$ M0 Q8 u7 \$ ?
11.         
    8 H' |7 g4 g; c4 u- q: Q) _: s
12.         '定义优化多段线的顶点坐标
    
13.         Ps(0) = -7: Ps(1) = -12
    
14.         Ps(2) = 7: Ps(3) = -12
    2 a) |# H3 n' E( |3 Q- g; |- |& L
15.         Ps(4) = 12: Ps(5) = -7
    
16.         Ps(6) = 12: Ps(7) = 0
    
17.         Ps(8) = -12: Ps(9) = 0
    
18.         Ps(10) = -12: Ps(11) = -7
    
19.         
    9 g3 A' W% _1 j1 P# _" n
20.         '创建优化多段线
    / f+ I, i+ {$ j; [& E: V& w& {
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    , q' j& M+ ?$ V  w' K
22.         
      P2 Z/ A) u3 e, F7 u
23.         '多段线闭合
    
24.         PL(0).Closed = True
    0 k2 R! B" d# T+ [! `5 ~
25.         
    ( j% [. d- V% A3 {" q
26.         '多段线第2、3顶点间部分改为90度圆弧
    
27.         PL(0).SetBulge 1, .Utility.AngleToReal(22.5, acDegrees)
    ' o; B+ x' y% J* m. r' g9 [
28.         
    3 G( S1 i3 M: ?- S/ K2 y5 D$ e
29.         '多段线第4、5顶点间部分改为180度圆弧
    7 n& a$ N/ k$ i2 x
30.         PL(0).SetBulge 3, 1
    4 ?" {- K4 J, @5 h% y
31.                
    
32.         '多段线第6、1顶点间部分改为90度圆弧
    
33.         PL(0).SetBulge 5, .Utility.AngleToReal(22.5, acDegrees)
    . l) B' h8 `9 X6 `
34.         
    
35.         '用多段线做面域
    
36.         R1 = .ModelSpace.AddRegion(PL)
    
37.         
    3 e6 ]9 v2 ^( c, ~: r
38.         '把面域赋值给R2，便于下步使用
    
39.         Set R2 = R1(0)
    / H% R  _/ E. f7 s
40.         
    / _- g+ z9 o- T! Y/ a8 G
41.         '以原点为圆心，半径10画圆
    # S. M, r/ x! R# a1 {4 ?( U
42.         Set C(0) = .ModelSpace.AddCircle(P, 10)
    
43.         
    
44.         '用圆做面域
    
45.         R1 = .ModelSpace.AddRegion(C)
    ) v8 z6 Y9 `% r# B. f' w$ g. b, M
46.         
    
47.         '多段线做成的面域与圆做成的面域差集
    . x  G" [: D) _4 u, }$ X
48.         R2.Boolean acSubtraction, R1(0)
    : B7 `. W* S5 c& L* `: L6 j
49.         
    
50.         '把面域拉伸为三维实体S1，高度50
    ' x+ m' h. b* b
51.         Set S1 = .ModelSpace.AddExtrudedSolid(R2, 50, 0)
    
52.         
    
53.         '新建UCS，原世界坐标系WCS的XZ平面为新UCS“AAA”的XY平面，原点不变
    : H% @% Q( s5 n
54.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0
    6 e9 {* G1 H+ o1 a1 g) S5 i  ]7 R1 V
55.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1
    7 n. U4 [% N- a0 V9 p9 C4 ?
56.         Set UCS = .UserCoordinateSystems.Add(P, Xp, Yp, "AAA")
    
57.         
    
58.         '把UCS“AAA”置为当前
    ' B; s8 ^! l2 }# B# J# b
59.         .ActiveUCS = UCS
    ) S6 U; p+ i7 @( a5 c' u
60.         
    
61.         '以世界坐标系(0,12,10)为圆心，半径2画圆
    
62.         P(0) = 0: P(1) = 12: P(2) = 10
    
63.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    
64.         
    , W( W% R9 x. g) r
65.         '把该圆做成面域
    
66.         R1 = .ModelSpace.AddRegion(C)
    
67.         
    ) c6 G6 p/ U& o. x
68.         '拉伸该面域为三维实体S2，高度24
    9 {) G, q# k3 B& |; J, L
69.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    
70.         
    , ~6 Z' I- I$ E4 O. ^: e
71.         'S1与S2差集，新实体为S1
    
72.         S1.Boolean acSubtraction, S2
    ( q! f6 B1 X2 ]7 w
73.         
    & W- L/ |( V! d4 K( r5 W. ]+ _
74.         '以世界坐标系(0,12,40)为圆心，半径2画圆
    5 b! [5 d4 V7 _
75.         P(0) = 0: P(1) = 12: P(2) = 40
    
76.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    
77.         
    - L& h6 f. T$ @7 |8 e7 R8 M- u
78.         '把该圆做成面域
    ( m- _2 M& M/ ?6 G7 @( Q
79.         R1 = .ModelSpace.AddRegion(C)
    ' L: G& P; S& f' j; D
80.         
    % B, J5 @  ?' U6 G( Z
81.         '拉伸该面域为三维实体S2，高度24
    
82.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    % R5 o& @* `) X: s( G: J8 r
83.         
    - D5 Q$ C- [. F* X; x  w3 S. u
84.         '差集
      x& O+ D' U9 }# x% L7 k+ \
85.         S1.Boolean acSubtraction, S2
    
86.     End With
    
87. End Sub
    0 A, m/ c% O% S. U9 J# i3 Y9 Q

复制代码