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

ghostcheng

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

ghostcheng

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

woaishuijia

第一个图

1. 
   
2. Sub A()
   ! h% T5 V' e2 ?( G/ o/ P' c
3.     Dim PL(0) As AcadLWPolyline, Ps(17) As Double, R As Variant, P(2) As Double, D(2) As Double
   9 x6 f# V  {8 }
4.     With ThisDrawing
   
5.    
   8 o5 d0 C% p& s! x+ ]$ u: ?2 w
6.         '转换到世界坐标系WCS
   
7.         SendCommand "ucs w "
   7 g& j& S- ?, w$ R
8.         
   7 ?( j- B: u5 }& F# K) O* W' _( P# p
9.         '定义优化多段线的顶点坐标
     \& s  I0 Z+ p
10.         Ps(0) = 30: Ps(1) = 0
    
11.         Ps(2) = 100: Ps(3) = 0
    7 p0 L$ X  Q+ D. [  t9 [& M
12.         Ps(4) = 100: Ps(5) = 25
    0 p0 H7 [, D1 ~( B4 j; p3 ~
13.         Ps(6) = 95: Ps(7) = 30
    0 n, s8 W8 }, S( u, d: ~( J2 Q) r
14.         Ps(8) = 65: Ps(9) = 30
    8 \/ `; x/ X0 ]9 T
15.         Ps(10) = 60: Ps(11) = 35
    % N' }2 Q) e9 F# ^# o
16.         Ps(12) = 60: Ps(13) = 95
    9 Q- S5 d: Q5 r$ O9 ~( _! X* ]
17.         Ps(14) = 55: Ps(15) = 100
    
18.         Ps(16) = 30: Ps(17) = 100
    
19.         
    
20.         '创建优化多段线
    
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    
22.         
    
23.         '多段线闭合
    " {; ?  w' t* W+ y8 ]3 |
24.         PL(0).Closed = True
    
25.         
    0 [4 B3 `+ i7 l
26.         '多段线第3、4顶点间部分改为90度圆弧
    0 d' |4 j: Q3 I! Z! y6 l* e
27.         PL(0).SetBulge 2, Tan(.Utility.AngleToReal(22.5, acDegrees))
    
28.         
    
29.         '多段线第5、6顶点间部分改为90度凹进圆弧
    9 {: m" t/ U$ q; K, H8 Y# _/ h8 F
30.         PL(0).SetBulge 4, -Tan(.Utility.AngleToReal(22.5, acDegrees))
    ( m) h3 t- c- Y' K
31.         
    
32.         '多段线第7、8顶点间部分改为90度圆弧
    
33.         PL(0).SetBulge 6, Tan(.Utility.AngleToReal(22.5, acDegrees))
    
34.         
      ~$ D& v, T/ ]3 I! w4 @; w
35.         '用多段线做面域
    ! B' J5 t3 {' M/ t
36.         R = .ModelSpace.AddRegion(PL)
    
37.         
    
38.         '定义旋转轴起点
    
39.         P(0) = 0: P(1) = 0: P(2) = 0
    2 x. N, c2 S- l: I  w) l! Z. Q
40.         
    
41.         '定义旋转轴方向
    
42.         D(0) = 0: D(1) = 1: D(2) = 0
    * Z# a6 ^/ ~# L9 m; E" C
43.         
    $ h% n2 ~0 e- `6 B& R- W1 U
44.         '旋转360度建模
    
45.         .ModelSpace.AddRevolvedSolid R(0), P, D, .Utility.AngleToReal(180, acDegrees) * 2
    8 {# D+ K: q0 S/ u6 c" j# N
46.     End With
    9 N6 ^4 m$ P; N1 Q- ?# ^; t* i  ?
47. End Sub
    4 L; w* n* L/ m1 d

复制代码

[ 本帖最后由 woaishuijia 于 2009-2-7 20:49 编辑 ]

woaishuijia

第二个图

1. 
   , F$ {% f) J1 n) m! W
2. Sub A()
   7 O. D2 W' n: m7 H
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
   
5.     Dim S1 As Acad3DSolid, S2 As Acad3DSolid
   / m" K: E5 @% f6 x8 r0 f- a  O
6.     Dim UCS As AcadUCS, Xp(2) As Double, Yp(2) As Double
   : m1 o% z+ V) o+ _  G' O
7.     With ThisDrawing
   8 }4 J) T7 R1 y0 I
8.    
   
9.         '转换到世界坐标系WCS
   
10.         SendCommand "ucs w "
    
11.         
    % M$ l" y. X0 i" P( h& q
12.         '定义优化多段线的顶点坐标
    
13.         Ps(0) = -7: Ps(1) = -12
    7 N, e' o7 X. e# t5 ?
14.         Ps(2) = 7: Ps(3) = -12
    
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
    ( e' c5 r. L* x* s3 Z) Y" J
19.         
    
20.         '创建优化多段线
    
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    ' r0 ~$ o) T  b0 P9 D2 e
22.         
    
23.         '多段线闭合
    
24.         PL(0).Closed = True
    
25.         
    7 R! V0 o6 L5 N* [
26.         '多段线第2、3顶点间部分改为90度圆弧
    & f( T$ Q5 l* T: P7 i8 Q0 N
27.         PL(0).SetBulge 1, .Utility.AngleToReal(22.5, acDegrees)
    " }" B% Q/ _- H7 X3 G  n
28.         
    + V' p, H. o$ s7 m& V: v" ]# D3 k
29.         '多段线第4、5顶点间部分改为180度圆弧
    7 v4 t1 }7 G/ s3 K1 Y) f) F# @
30.         PL(0).SetBulge 3, 1
    
31.                
    . {+ I1 o5 Z$ H* d" l
32.         '多段线第6、1顶点间部分改为90度圆弧
    
33.         PL(0).SetBulge 5, .Utility.AngleToReal(22.5, acDegrees)
    
34.         
    ( [- y" J1 Y* n. Q# Y7 a
35.         '用多段线做面域
    
36.         R1 = .ModelSpace.AddRegion(PL)
    + w$ F# J/ O6 `+ ?5 E
37.         
    
38.         '把面域赋值给R2，便于下步使用
    
39.         Set R2 = R1(0)
      J8 f2 p3 T7 X% q0 G8 H
40.         
    
41.         '以原点为圆心，半径10画圆
    
42.         Set C(0) = .ModelSpace.AddCircle(P, 10)
    4 r5 C% B, F, S1 S
43.         
    
44.         '用圆做面域
    4 f! S* [& G0 c& ?
45.         R1 = .ModelSpace.AddRegion(C)
    1 u6 B* K5 y+ v  p7 `
46.         
    1 w  _; H( F+ u; j. w
47.         '多段线做成的面域与圆做成的面域差集
    
48.         R2.Boolean acSubtraction, R1(0)
    
49.         
    1 O5 Z8 q  j' r
50.         '把面域拉伸为三维实体S1，高度50
    
51.         Set S1 = .ModelSpace.AddExtrudedSolid(R2, 50, 0)
    . X- }  @/ p9 |# `$ N" Q+ B
52.         
    $ F1 d5 o4 v4 q  q+ s9 {5 G, o
53.         '新建UCS，原世界坐标系WCS的XZ平面为新UCS“AAA”的XY平面，原点不变
    7 c8 y. J, s9 p. @% H1 w
54.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0
    
55.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1
    
56.         Set UCS = .UserCoordinateSystems.Add(P, Xp, Yp, "AAA")
    5 u+ S* v/ h0 x$ V
57.         
    ) a# O9 V) Z9 ?* U2 F  l  u
58.         '把UCS“AAA”置为当前
    - N# L3 x2 l+ |- Y$ P
59.         .ActiveUCS = UCS
    : D  \  R  I4 m: o5 |) i
60.         
    
61.         '以世界坐标系(0,12,10)为圆心，半径2画圆
    5 q& Z/ t. c# v7 y8 t8 C3 O
62.         P(0) = 0: P(1) = 12: P(2) = 10
    4 Z2 z+ N, A! U' w2 M
63.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    2 ]  q# s. L- L
64.         
    8 |0 j- ^' {- K! N
65.         '把该圆做成面域
    
66.         R1 = .ModelSpace.AddRegion(C)
    ) q, d# r6 K! q! z% E3 M% M
67.         
    ( X! d5 g: c9 l2 O. ~! o
68.         '拉伸该面域为三维实体S2，高度24
      b" f; O1 h/ ]1 y3 J6 B: h
69.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    
70.         
    ( O( C8 T* W2 R7 s' {
71.         'S1与S2差集，新实体为S1
    ' ^& p1 F5 \. h* E& g7 `
72.         S1.Boolean acSubtraction, S2
    1 f2 N* i* o" T- h6 o8 [* M
73.         
    ) ?0 `: L+ c, O' s! c
74.         '以世界坐标系(0,12,40)为圆心，半径2画圆
    ! p2 v* }. y8 b( M1 S
75.         P(0) = 0: P(1) = 12: P(2) = 40
    3 @3 K3 {3 `4 Z* v/ [
76.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    
77.         
    3 |1 G8 ?7 D+ b5 o( l
78.         '把该圆做成面域
    
79.         R1 = .ModelSpace.AddRegion(C)
    / j( ]7 l! B& \+ l0 }9 x
80.         
    
81.         '拉伸该面域为三维实体S2，高度24
    
82.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    
83.         
    
84.         '差集
    ) ^) T9 Z! _0 n, J% X% U
85.         S1.Boolean acSubtraction, S2
    ) F5 s; f# W5 \7 W- R+ U
86.     End With
    
87. End Sub
    ; j" J7 o8 ]. f. e4 L6 u+ f

复制代码