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

jjww123 · 发表于 2009-3-15 11:49:06

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

Private Sub CommandButton1_Click()
'开始画图过程~~~~

't为椅子面长度，c为椅子腿长度，h为椅子面宽度，S为靠背长。。。主要的画图思路为，先画椅子腿（由4个长方体构成），然后再画椅子面（也是长方体），再画靠背---由多段线构成位面然后拉伸（这个有变换了一下坐标），很简单的一个图！

      '取数据并赋值
      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

      Dim boxobj1 As Acad3DSolid, boxobj2 As Acad3DSolid, boxobj3 As Acad3DSolid, boxobj4 As Acad3DSolid
      Dim boxobj5 As Acad3DSolid, boxobj6 As Acad3DSolid

      Dim length As Double, width As Double, height As Double

      Dim center1(2) As Double, center2(2) As Double, center3(2) As Double, center4(2) As Double
      Dim center5(2) As Double, center6(2) As Double

      '椅子脚

      center1(0) = 1: center1(1) = 1: center1(2) = 0
      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
      length = 2: width = 2: height = c - 1.5

      Set boxobj2 = ThisDrawing.ModelSpace.AddBox(center2, length, width, height)


      center3(0) = t + 0.5: center3(1) = h - 1: center3(2) = 0
      length = 2: width = 2: height = c - 1.5

      Set boxobj3 = ThisDrawing.ModelSpace.AddBox(center3, length, width, height)

      center4(0) = 1: center4(1) = h - 1: center4(2) = 0
      length = 2: width = 2: height = c - 1.5

      Set boxobj4 = ThisDrawing.ModelSpace.AddBox(center4, length, width, height)


      '椅子脚横杆（1）

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

      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

      Set boxobj6 = ThisDrawing.ModelSpace.AddBox(center6, length, width, height)

   '转换视角，画靠背、坐垫、椅子脚横杆（2）

      Dim UCS As AcadUCS, Op(2) As Double, Xp(2) As Double, Yp(2) As Double

         With ThisDrawing

         '下面3个点用于定义新的UCS
         Op(0) = 0: Op(1) = 0: Op(2) = 0 '新UCS的原点
         Xp(0) = 1: Xp(1) = 0: Xp(2) = 0 '新UCS的X方向
         Yp(0) = 0: Yp(1) = 0: Yp(2) = 1 '新UCS的Y方向

         '新建UCS
         Set UCS = .UserCoordinateSystems.Add(Op, Xp, Yp, "AAA")

         '激活新UCS
         .ActiveUCS = UCS

         End With


      '靠背

      Dim PL(0) As AcadLWPolyline, Ps(11) As Double

      Dim R1 As Variant

      Dim S1 As Acad3DSolid

         With ThisDrawing

      '定义优化多段线的顶点坐标
      Ps(0) = 0: Ps(1) = c / 2 + 0.75
      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

      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

      Ps(10) = -0.173 * 0.4 * S: Ps(11) = 0.984 * 0.4 * S + c / 2 + 0.75

      '创建优化多段线
      Set PL(0) = .ModelSpace.AddLightWeightPolyline(Ps)

      '多段线闭合
      PL(0).Closed = True

      PL(0).SetBulge 3, Tan(.Utility.AngleToReal(22.5, acDegrees))
      PL(0).SetBulge 1, Tan(.Utility.AngleToReal(15, acDegrees))

      R1 = .ModelSpace.AddRegion(PL)

      Set S1 = .ModelSpace.AddExtrudedSolid(R1(0), -h, 0)



      '坐垫

      Dim PL1(0) As AcadLWPolyline, Ps1(11) As Double

      Dim R2 As Variant

      Dim S2 As Acad3DSolid

      Ps1(0) = 0: Ps1(1) = (c - 1.5) / 2
      Ps1(2) = t + 1.5: Ps1(3) = (c - 1.5) / 2

      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
      Ps1(8) = (t + 1.5) / 3: Ps1(9) = (c - 1.5) / 2 + 1.5

      Ps1(10) = 0: Ps1(11) = (c - 1.5) / 2 + 1.5

   Set PL1(0) = .ModelSpace.AddLightWeightPolyline(Ps1)

   PL1(0).Closed = True

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

   R2 = .ModelSpace.AddRegion(PL1)

   Set S2 = .ModelSpace.AddExtrudedSolid(R2(0), -h, 0)


      '椅子脚横杆（2）
      Dim PL2(0) As AcadLWPolyline, Ps2(11) As Double

      Dim R3 As Variant

      Dim S3 As Acad3DSolid

      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
      Ps2(6) = 1.5: Ps2(7) = -0.2 * c - 1

      Ps2(8) = 1.5: Ps2(9) = -0.2 * c - 0.5

      Ps2(10) = 1.5: Ps2(11) = -0.2 * c

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

   PL2(0).Closed = True

   R3 = .ModelSpace.AddRegion(PL2)

   Set S3 = .ModelSpace.AddExtrudedSolid(R3(0), -h, 0)


         End With

      '转变椅子视角

      Dim V As AcadView, D(2) As Double

      With ThisDrawing

         '新建视图
         Set V = .Views.Add("AAA")

         '设置新视图的方向
         D(0) = 0.5: D(1) = -1: D(2) = 0.3

         V.Direction = D

         '活动视口设置为该视图
         .ActiveViewport.SetView V

         '重置活动视口
         .ActiveViewport = .ActiveViewport

      End With

      '真实模式

   ThisDrawing.SendCommand "vscurrent r "


      '缩放视图

      ZoomAll

Unload Me
End Sub

请woaishuijia版主指导~~~非常感谢！

		自动登录	找回密码
密码			注册

通知

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

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块