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

ghostcheng

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

ghostcheng

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

woaishuijia

第一个图
- u8 w  I# D* P8 `* u9 k2 I

1. 
   0 ^7 K% \& j$ [* _
2. Sub A()
   
3.     Dim PL(0) As AcadLWPolyline, Ps(17) As Double, R As Variant, P(2) As Double, D(2) As Double
   ; c" m2 ^. r1 b) W: i7 m: o
4.     With ThisDrawing
   ( e# S8 ~6 D: w- j1 H; E
5.    
   0 k9 X) s' a( I. t; |% W
6.         '转换到世界坐标系WCS
   
7.         SendCommand "ucs w "
   
8.         
   0 ^: S! T9 d) \, _: [2 o+ I
9.         '定义优化多段线的顶点坐标
   
10.         Ps(0) = 30: Ps(1) = 0
    
11.         Ps(2) = 100: Ps(3) = 0
    
12.         Ps(4) = 100: Ps(5) = 25
    
13.         Ps(6) = 95: Ps(7) = 30
    / p7 D: f& b: D' h" R
14.         Ps(8) = 65: Ps(9) = 30
    % f- S2 A+ C5 r9 h4 _0 L
15.         Ps(10) = 60: Ps(11) = 35
    
16.         Ps(12) = 60: Ps(13) = 95
    
17.         Ps(14) = 55: Ps(15) = 100
    ) `9 g4 `4 d- w8 p4 R. a
18.         Ps(16) = 30: Ps(17) = 100
    1 K. j6 N0 d" _3 ~  u
19.         
    ( r1 z9 ]+ `3 n9 E2 n6 u' K
20.         '创建优化多段线
    3 i3 r2 q8 F3 V+ x
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    3 @& p7 d8 G* v  E
22.         
    9 E0 F: w: k; Q; B
23.         '多段线闭合
    4 d+ @3 P5 [1 }4 w! u# }  J" }
24.         PL(0).Closed = True
    / t3 K8 k+ V4 Z8 d) a, }9 x
25.         
    
26.         '多段线第3、4顶点间部分改为90度圆弧
    
27.         PL(0).SetBulge 2, Tan(.Utility.AngleToReal(22.5, acDegrees))
    : ^+ E! U7 _% o. r
28.         
    ( J- b3 N6 a$ F8 x& Y
29.         '多段线第5、6顶点间部分改为90度凹进圆弧
    
30.         PL(0).SetBulge 4, -Tan(.Utility.AngleToReal(22.5, acDegrees))
    
31.         
    & s! c: e! q1 _; Q% }: p( }$ i
32.         '多段线第7、8顶点间部分改为90度圆弧
    ! `6 d1 d: K2 e' E0 G4 z& L* a
33.         PL(0).SetBulge 6, Tan(.Utility.AngleToReal(22.5, acDegrees))
    
34.         
    
35.         '用多段线做面域
    
36.         R = .ModelSpace.AddRegion(PL)
    
37.         
    $ w& z7 o9 K0 a3 U5 Y( E
38.         '定义旋转轴起点
    
39.         P(0) = 0: P(1) = 0: P(2) = 0
    
40.         
    
41.         '定义旋转轴方向
    & M8 ?) g& M% D; ~, B. O, o# N
42.         D(0) = 0: D(1) = 1: D(2) = 0
    
43.         
    ) x/ P! f3 G4 W' U4 G- h
44.         '旋转360度建模
    6 j% ]8 |# E; k. K8 P; \
45.         .ModelSpace.AddRevolvedSolid R(0), P, D, .Utility.AngleToReal(180, acDegrees) * 2
    6 Q5 K6 w/ G* b- g1 E. X- W
46.     End With
    
47. End Sub
    : Y* M0 g  T! p; Y

复制代码

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

woaishuijia

第二个图

1. 
   7 j( s5 [9 D7 G$ @) M+ n3 g
2. Sub A()
   ) G9 q6 ^$ F4 a4 `: R$ b- j
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
   
6.     Dim UCS As AcadUCS, Xp(2) As Double, Yp(2) As Double
   
7.     With ThisDrawing
   
8.    
   " @2 `. {# F/ A8 u4 U  N
9.         '转换到世界坐标系WCS
   . \# B) Z) V' z1 ?
10.         SendCommand "ucs w "
    3 h! Y1 T1 |. @; L. y) }2 P- `, F
11.         
    
12.         '定义优化多段线的顶点坐标
    4 J6 X4 z& a9 v& k: q6 I
13.         Ps(0) = -7: Ps(1) = -12
    
14.         Ps(2) = 7: Ps(3) = -12
    6 z/ L* u" o* x( M
15.         Ps(4) = 12: Ps(5) = -7
    
16.         Ps(6) = 12: Ps(7) = 0
    / w5 y$ N1 a1 d$ l) A, l( u) d/ l& S
17.         Ps(8) = -12: Ps(9) = 0
    # h8 L+ j: z$ W" l
18.         Ps(10) = -12: Ps(11) = -7
    . ^! _2 Y4 n( J+ h
19.         
    
20.         '创建优化多段线
    7 E) C$ p5 ?( a6 z) d
21.         Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
    ) x- t6 E+ {0 l, F
22.         
    ! \8 o: w/ V/ ^" z/ _
23.         '多段线闭合
    
24.         PL(0).Closed = True
    * z" s* W$ X6 L3 f+ ^( ~
25.         
    
26.         '多段线第2、3顶点间部分改为90度圆弧
    
27.         PL(0).SetBulge 1, .Utility.AngleToReal(22.5, acDegrees)
    / ?: Z- S. F' f
28.         
    2 \% L% }7 K6 U5 `
29.         '多段线第4、5顶点间部分改为180度圆弧
    0 _$ I3 G( z! b9 d% a& r
30.         PL(0).SetBulge 3, 1
    
31.                
    2 @, s1 z/ J4 x& v
32.         '多段线第6、1顶点间部分改为90度圆弧
    
33.         PL(0).SetBulge 5, .Utility.AngleToReal(22.5, acDegrees)
    
34.         
    
35.         '用多段线做面域
    6 y0 C' m- W; P+ ~1 D- F
36.         R1 = .ModelSpace.AddRegion(PL)
    
37.         
    
38.         '把面域赋值给R2，便于下步使用
    
39.         Set R2 = R1(0)
    1 {1 F2 m# S6 C- v
40.         
      q/ N9 ?. s% M
41.         '以原点为圆心，半径10画圆
    ( W! ^! l* A/ x3 V* Q* `- w$ Q
42.         Set C(0) = .ModelSpace.AddCircle(P, 10)
    ( A& @5 K5 |/ R# V
43.         
    ) t7 S8 f9 O4 Y$ q" w
44.         '用圆做面域
    , q$ t$ `5 m% C0 y6 S+ q% h
45.         R1 = .ModelSpace.AddRegion(C)
    ' H9 }8 \# r5 f' V) U
46.         
    
47.         '多段线做成的面域与圆做成的面域差集
    
48.         R2.Boolean acSubtraction, R1(0)
    3 {! B* I- K9 n$ q- Y
49.         
    / \" n- [, I6 e) ^
50.         '把面域拉伸为三维实体S1，高度50
    ' o- ^" x3 y6 `
51.         Set S1 = .ModelSpace.AddExtrudedSolid(R2, 50, 0)
    
52.         
    ' ?2 Z/ S, y! a/ Q: n
53.         '新建UCS，原世界坐标系WCS的XZ平面为新UCS“AAA”的XY平面，原点不变
    
54.         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0
    1 j  d  t( m2 S0 V  d
55.         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1
    
56.         Set UCS = .UserCoordinateSystems.Add(P, Xp, Yp, "AAA")
    $ q3 [" Y% L" B5 Y1 O3 R" L
57.         
    
58.         '把UCS“AAA”置为当前
    
59.         .ActiveUCS = UCS
    8 v: }* h* N: c( s3 ]3 d  `$ L- v% [
60.         
    
61.         '以世界坐标系(0,12,10)为圆心，半径2画圆
    & Z7 h; N& ~! @
62.         P(0) = 0: P(1) = 12: P(2) = 10
    
63.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    - D. C" l6 k+ ?6 R0 l* `- e
64.         
    ! k. F; C- L  ~
65.         '把该圆做成面域
    
66.         R1 = .ModelSpace.AddRegion(C)
    4 `* j/ {. |/ b0 ^% F. @
67.         
    
68.         '拉伸该面域为三维实体S2，高度24
    / K( ?4 r1 A: C- F' @# X
69.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    
70.         
    % E; S$ c# d/ `4 M
71.         'S1与S2差集，新实体为S1
    
72.         S1.Boolean acSubtraction, S2
    
73.         
    
74.         '以世界坐标系(0,12,40)为圆心，半径2画圆
    7 J  T- f9 y2 x' ?; _
75.         P(0) = 0: P(1) = 12: P(2) = 40
    
76.         Set C(0) = .ModelSpace.AddCircle(P, 2)
    ) U7 F. y! y, U( U
77.         
    
78.         '把该圆做成面域
    
79.         R1 = .ModelSpace.AddRegion(C)
    + c1 g5 G! `5 ~7 K* F: h
80.         
    
81.         '拉伸该面域为三维实体S2，高度24
    
82.         Set S2 = .ModelSpace.AddExtrudedSolid(R1(0), 24, 0)
    ' X5 n! I/ ?# M0 `" a' J
83.         
    % Q* n8 c# G, p% m
84.         '差集
    2 Y/ y% k) ]2 E0 ]6 c5 x0 m; u4 P
85.         S1.Boolean acSubtraction, S2
    
86.     End With
    
87. End Sub
    9 [* M9 ~6 ?- C: S# a* Q5 v

复制代码