大侠们能否帮我画一个三视图，原图代码已经给出！

jjww123

Private Sub CommandButton1_Click()
# v2 ~+ t* d! s7 I/ g'开始画图过程~~~~
! X, Q, Y, a. a) v$ X9 Y( c         
. P: @! {( [# }- I" {'t为椅子面长度，c为椅子腿长度，h为椅子面宽度，S为靠背长。。。主要的画图思路为，先画椅子腿（由4个长方体构成），然后再画椅子面（也是长方体），再画靠背---由多段线构成位面然后拉伸（这个有变换了一下坐标），很简单的一个图！
        
         '取数据并赋值
+ o$ u- S) S! X$ ^$ U' R         Dim t As Double, c As Double, h As Double, S As Double
   
         t = TextBox2.Text: c = TextBox3.Text: h = TextBox4.Text: S = TextBox5.Text
   
$ z. E4 e% |$ q' o8 a; ^" Z         Dim boxobj1 As Acad3DSolid, boxobj2 As Acad3DSolid, boxobj3 As Acad3DSolid, boxobj4 As Acad3DSolid
         Dim boxobj5 As Acad3DSolid, boxobj6 As Acad3DSolid

. I: C' f2 ^* q         Dim length As Double, width As Double, height As Double

, P0 S$ P. l) [! T         Dim center1(2) As Double, center2(2) As Double, center3(2) As Double, center4(2) As Double
9 f6 Z1 v4 g" w! o; N) y# i; q         Dim center5(2) As Double, center6(2) As Double

) j' ?. d  o+ w8 }# P+ M
         '椅子脚

        center1(0) = 1: center1(1) = 1: center1(2) = 0
) K- ]+ q& H7 V( \& c+ _        length = 2: width = 2: height = c - 1.5

        Set boxobj1 = ThisDrawing.ModelSpace.AddBox(center1, length, width, height)


        center2(0) = t + 0.5: center2(1) = 1: center2(2) = 0
3 S0 ]% i, r2 D2 x        length = 2: width = 2: height = c - 1.5
" J# r) D7 J, ~. `# k/ k( V1 a( U7 f
        Set boxobj2 = ThisDrawing.ModelSpace.AddBox(center2, length, width, height)
* G4 x! j0 g# s        
, W( p: I! c$ P0 m& n5 o' `. t
: D: [0 [, q" L  ^        center3(0) = t + 0.5: center3(1) = h - 1: center3(2) = 0
2 T5 [; r% j8 B% B        length = 2: width = 2: height = c - 1.5

        Set boxobj3 = ThisDrawing.ModelSpace.AddBox(center3, length, width, height)
  \7 a; ~8 [9 i
/ j) b3 T) w4 l; ^9 a$ ^( A
& d8 x! _) J6 `1 L        center4(0) = 1: center4(1) = h - 1: center4(2) = 0
        length = 2: width = 2: height = c - 1.5
6 Z$ l7 u% A4 \# y8 S2 D
        Set boxobj4 = ThisDrawing.ModelSpace.AddBox(center4, length, width, height)
, v& \/ J$ N/ ]4 s  f2 Y

3 T- ~$ y8 P$ M. @2 P4 {        
+ _& h$ w1 x3 ?8 A( v5 }        '椅子脚横杆（1）
/ d$ U" W; X7 N- A# ^+ h) X
        center5(0) = (t + 1.5) / 2: center5(1) = 1: center5(2) = 0.2 * c
; _% g& g) x7 r& @$ u        length = t - 2.5: width = 1: height = 1

0 m7 y" ?/ O  Z/ ^        Set boxobj5 = ThisDrawing.ModelSpace.AddBox(center5, length, width, height)


        center6(0) = (t + 1.5) / 2: center6(1) = h - 1: center6(2) = 0.2 * c
        length = t - 2.5: width = 1: height = 1

$ F, C, g6 R' g% E3 P        Set boxobj6 = ThisDrawing.ModelSpace.AddBox(center6, length, width, height)
/ f2 C% H; E/ o( C8 }

       '转换视角，画靠背、坐垫、椅子脚横杆（2）
2 N, C( ?  I7 \: g( }
; J5 R* h# Y5 o# f+ Z        Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double
( X+ {4 l6 y/ I/ T# i/ ]% }   
            With ThisDrawing
        
             '下面3个点用于定义新的UCS
            Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
8 U0 S  G+ B8 ]$ ?            Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
. Z8 O9 M# u" a            Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向
            
             '新建UCS
             Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")
            
             '激活新UCS
             .ActiveUCS = UCS
! j# k# i8 h, h+ m4 v$ `( v      
            End With

        
& t5 n! h6 h: c. ?# ~4 G9 z4 ?        '靠背
        
) k! K  D' b. A( D) u        Dim PL(0) As AcadLWPolyline, Ps(11) As Double
. ?9 l1 G. q3 m. o. W  Z( U# p) x   
        Dim R1 As Variant
   
        Dim S1 As Acad3DSolid
9 m7 Z) _& @! s, q. n) e9 K   
) A, a9 ]7 Y# w; K# G9 S: A4 y            With ThisDrawing
0 w* ~! J" n# |- m   
" x) t/ j+ d+ K/ L8 {        '定义优化多段线的顶点坐标
- C' G5 v+ X4 a- C; Y: x& H# y        Ps(0) = 0: Ps(1) = c / 2 + 0.75
" G+ x6 d* \* o& |5 m4 p% r        Ps(2) = 1.5: Ps(3) = c / 2 + 0.75
        
        Ps(4) = 1.5 - 0.173 * 0.4 * S: Ps(5) = 0.984 * 0.4 * S + c / 2 + 0.75
        
- l6 I: \' x8 T& u, q  M! K        Ps(6) = 1.5 - 0.324 * S: Ps(7) = 0.939 * S + c / 2 + 0.75
        Ps(8) = -0.324 * S: Ps(9) = 0.939 * S + c / 2 + 0.75
, b1 f6 n* q6 C6 l  x) w, _        
        Ps(10) = -0.173 * 0.4 * S: Ps(11) = 0.984 * 0.4 * S + c / 2 + 0.75
$ n+ U% \% p, D2 g2 J3 f        
        '创建优化多段线
        Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)
        
        '多段线闭合
        PL(0).Closed = True
% O- B  O* X; @/ V- Z        
9 b& ^" `/ o( Z' h( l        PL(0).SetBulge 3, Tan(.Utility.AngleToReal(22.5, acDegrees))
" d8 u6 M5 p+ x$ I, h        PL(0).SetBulge 1, Tan(.Utility.AngleToReal(15, acDegrees))
  T, l+ w+ w0 u        
5 @) W5 t4 j, \        R1 = .ModelSpace.AddRegion(PL)
        
        Set S1 = .ModelSpace.AddExtrudedSolid(R1(0), -h, 0)
        
. u* l, F2 S2 @. ?' E% w        
      
: M- v7 Z1 S4 r* X/ N        '坐垫
" J% R+ _' \& e2 o8 E! @$ z$ {
        Dim PL1(0) As AcadLWPolyline, Ps1(11) As Double
4 W' v+ R9 `( ~1 i* |2 M            
( G6 U: u4 O7 i) _" R' x        Dim R2 As Variant
0 S/ {' R9 M3 K   
3 @( U* R* |& p2 p* M- ^) W6 E        Dim S2 As Acad3DSolid

& M& V5 a7 s; g* J        Ps1(0) = 0: Ps1(1) = (c - 1.5) / 2
        Ps1(2) = t + 1.5: Ps1(3) = (c - 1.5) / 2
        
. m* j5 p4 T  q  e* j8 A4 x        Ps1(4) = t + 0.5: Ps1(5) = (c - 1.5) / 2 + 1.5
        
        Ps1(6) = (t + 1.5) / 2: Ps1(7) = (c - 1.5) / 2 + 1.5
* h2 s! h; e7 a' \8 ?6 O        Ps1(8) = (t + 1.5) / 3: Ps1(9) = (c - 1.5) / 2 + 1.5
( ~$ s. l8 A' D3 y        
        Ps1(10) = 0: Ps1(11) = (c - 1.5) / 2 + 1.5
1 a3 `7 X2 N: h8 L

       Set PL1(0) = .ModelSpace.AddLightWeightPolyline(Ps1)
. j4 b$ W% v6 s9 x+ d, X  z
       PL1(0).Closed = True

       PL1(0).SetBulge 1, Tan(.Utility.AngleToReal(22.5, acDegrees))

       R2 = .ModelSpace.AddRegion(PL1)
5 n5 h  C* ]/ M& W5 x
       Set S2 = .ModelSpace.AddExtrudedSolid(R2(0), -h, 0)

  k3 P5 X9 x7 ]# f: |
         
         '椅子脚横杆（2）
$ O1 {; m" K9 p7 w1 g: @. A        Dim PL2(0) As AcadLWPolyline, Ps2(11) As Double
            
        Dim R3 As Variant
   
        Dim S3 As Acad3DSolid
   
, A; i# q5 V, w# ~        Ps2(0) = 0.5: Ps2(1) = -0.2 * c
        
        Ps2(2) = 0.5: Ps2(3) = -0.2 * c - 0.5
        
        Ps2(4) = 0.5: Ps2(5) = -0.2 * c - 1
8 g- o6 t) j* Y! R  _# A+ v        Ps2(6) = 1.5: Ps2(7) = -0.2 * c - 1
9 ]7 z* `/ z3 J  z. x9 }! s        
        Ps2(8) = 1.5: Ps2(9) = -0.2 * c - 0.5
% h2 Y9 C, w0 @/ t8 Q        
/ `6 h+ ]6 r& `7 {/ ]0 j0 I. f$ w        Ps2(10) = 1.5: Ps2(11) = -0.2 * c
) g9 o6 L2 E" T

       Set PL2(0) = .ModelSpace.AddLightWeightPolyline(Ps2)

       PL2(0).Closed = True
( D9 S+ M! _5 D
       R3 = .ModelSpace.AddRegion(PL2)

       Set S3 = .ModelSpace.AddExtrudedSolid(R3(0), -h, 0)
           
/ h% L4 T% |! ^. T' c2 T$ k1 l  Z           
           End With

$ u& E  _( Y! _! a
2 {+ s2 U" s& b# T
        '转变椅子视角
) ~1 ~( ]! K# A9 h: {     
% V; Z4 C, t  p9 y+ I# y- r9 {+ _$ h        Dim V As AcadView, D(2) As Double
   
2 ^( @& c9 J" O) L' U, k        With ThisDrawing
        
            '新建视图
: b) R9 J0 m% b9 \            Set V = .Views.Add("AAA")
: l% R: g7 Z2 t; S  W         
9 ~+ ^! s2 h* P' Q             '设置新视图的方向
; a1 W* p' ]: a$ S7 D5 F            D(0) = 0.5: D(1) = -1: D(2) = 0.3
4 `, X0 E; ^- \: }8 X- O0 Q; k6 {        
            V.Direction = D
! y. k$ i0 |7 r2 ]        
            '活动视口设置为该视图
            .ActiveViewport.SetView V
+ A- V+ c* C% t5 {- ?3 ~' O: Q4 q# E        
            '重置活动视口
            .ActiveViewport = .ActiveViewport
  p8 }6 E9 r  U5 T( K   
. \2 v6 k0 J  e7 p+ c5 c& h        End With
     
        '真实模式
+ [, {/ L& q3 a$ O      
       ThisDrawing.SendCommand "vscurrent r "
4 {  ]3 }% V- l* f1 G+ C9 M   
! Y1 c* z* ^5 O# A        
) m4 z. E* m1 H3 d5 u) {: b        '缩放视图
% \6 O0 p. e: [/ w+ Q9 I( V) F) E        
/ P! _2 M! ^( }        ZoomAll
- z! j) F6 w& j% k' p0 n: n: `  o
, ^1 G' U, F5 E1 r* f9 a  p! c, B$ EUnload Me
2 S$ g. o4 p. F1 M2 FEnd Sub
0 s7 ^' |; W+ g; _
请woaishuijia版主指导~~~非常感谢！