绯村剑心 发表于 2010-2-10 11:41

再求高手做2个CAD的VBA编辑!

后面一个没有尺寸要求,就随便自己定义尺寸了!同样是要体着色的!谢谢大侠了…………


绯村剑心 发表于 2010-2-11 20:28

高手在哪呀~!:'(

woaishuijia 发表于 2010-2-11 20:53

第一个图在前一个帖子有人会CAD的VBA编辑吗?中画过了.
第二个图

    '声明一个原点三维数组/一个X轴方向三维数组/一个Y轴方向三维数组和一个UCS对象,用于在三维空间转换UCS
    Dim dblOrigin(2) As Double, dblXAxisPoint(2) As Double, dblYAxisPoint(2) As Double, objUCS As AcadUCS
    '声明一个包含六个二维点的坐标数组/一个有一个元素的优化多段线对象数组/一个用于接收面域的变体变量和一个三维实体对象,用于创建拉伸实体
    Dim dblVerticesList(11) As Double, objLWPLine(0) As AcadLWPolyline, varRegions As Variant, obj3DSolid As Acad3DSolid
    '声明一个三维点坐标和一个三维实体对象,用于创建圆柱体与拉伸实体差集
    Dim dblCenter(2) As Double, objCylinder As Acad3DSolid
    '声明一个三维点,用于与圆柱体中心点配合,指定圆柱体的旋转轴
    Dim dblPoint(2) As Double
    With ThisDrawing
      '把UCS设为WCS
      .SendCommand "ucs w "
      '创建二维优化多段线
      dblVerticesList(0) = -50
      dblVerticesList(2) = 50
      dblVerticesList(4) = 60: dblVerticesList(5) = 10
      dblVerticesList(6) = 60: dblVerticesList(7) = 60
      dblVerticesList(8) = -60: dblVerticesList(9) = 60
      dblVerticesList(10) = -60: dblVerticesList(11) = 10
      Set objLWPLine(0) = .ModelSpace.AddLightWeightPolyline(dblVerticesList)
      '多段线闭合
      objLWPLine(0).Closed = True
      '把多段线的三个直线段改为圆弧
      objLWPLine(0).SetBulge 1, Tan(.Utility.AngleToReal(90 / 4, acDegrees))
      objLWPLine(0).SetBulge 3, Tan(.Utility.AngleToReal(180 / 4, acDegrees))
      objLWPLine(0).SetBulge 5, Tan(.Utility.AngleToReal(90 / 4, acDegrees))
      '用多段线做边界创建面域
      varRegions = .ModelSpace.AddRegion(objLWPLine)
      '删除用过的多段线
      objLWPLine(0).Delete
      '用面域创建拉伸实体
      Set obj3DSolid = .ModelSpace.AddExtrudedSolid(varRegions(0), 300, 0)
      '删除用过的面域
      varRegions(0).Delete
      '创建用于差集的中间大圆柱体
      dblCenter(1) = 60: dblCenter(2) = 150
      Set objCylinder = .ModelSpace.AddCylinder(dblCenter, 50, 300)
      '差集
      obj3DSolid.Boolean acSubtraction, objCylinder
      '创建用于差集的第一个小圆柱实体
      dblCenter(2) = 30
      Set objCylinder = .ModelSpace.AddCylinder(dblCenter, 10, 120)
      '由于圆柱体的轴线平行于WCS的Z轴,在差集之前必须加以旋转,使其轴线与WCS的Y轴平行
      '用dblCenter做旋转轴的基点,在左侧(相对于WCS的XY平面)指定旋转轴的第二个点
      dblPoint(0) = -1: dblPoint(1) = 60: dblPoint(2) = 30
      '三维旋转小圆柱体
      objCylinder.Rotate3D dblCenter, dblPoint, .Utility.AngleToReal(90, acDegrees)
      '差集
      obj3DSolid.Boolean acSubtraction, objCylinder
      '重新指定中心点和旋转轴的第二个点,创建第二个小圆柱体并旋转/差集
      dblCenter(2) = 270: dblPoint(2) = 270
      Set objCylinder = .ModelSpace.AddCylinder(dblCenter, 10, 120)
      objCylinder.Rotate3D dblCenter, dblPoint, .Utility.AngleToReal(90, acDegrees)
      obj3DSolid.Boolean acSubtraction, objCylinder
      '指定实体的颜色
      obj3DSolid.color = 42
      '新建UCS
      dblXAxisPoint(0) = 1: dblXAxisPoint(1) = 0: dblXAxisPoint(2) = -1
      dblYAxisPoint(0) = -1: dblYAxisPoint(1) = 2: dblYAxisPoint(2) = -1
      Set objUCS = ThisDrawing.UserCoordinateSystems.Add(dblOrigin, dblXAxisPoint, dblYAxisPoint, "U")
      '改变视图方向和着色模式
      .SendCommand "plan u u" & vbCr & "ucs w shademode g "
    End With


[ 本帖最后由 woaishuijia 于 2010-2-11 22:33 编辑 ]

绯村剑心 发表于 2010-2-13 14:49

:) 多谢高手了~!感激啊……

xiao0san 发表于 2010-3-2 00:32

老大那个提交作品的编程做了没?

zlanai 发表于 2010-5-18 09:06

这个图形好看,是三维的么?
页: [1]
查看完整版本: 再求高手做2个CAD的VBA编辑!