如何用VBA在一个图中画出三视图？

jjww123 · 发表于 2009-3-9 19:46:49

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

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

x

麻烦详细点说下怎么实现。。。

比如下图。。我已经用VBA画好了最左边的那个图了，，而且UCS已经转换成那个角度了。。

怎么在旁边画出三视图？

大概知道用COPY。。只是不知道这个命令怎么用。。而且不知道怎么转换视角

[ 本帖最后由 jjww123 于 2009-3-12 13:52 编辑 ]

jjww123 · 发表于 2009-3-11 13:27:15

求救。。

:hug:

mimimao383 · 发表于 2009-3-11 18:17:52

把你的程序贴上看看。

jjww123 · 发表于 2009-3-12 13:49:51

楼上兄弟看看，，我把程序帖出来了。。也把图帖出来了！
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

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

通知

[求助] 如何用VBA在一个图中画出三视图？

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

浏览过的版块