社区 › VB › ACAD2006 VBA确定Acad3dSolid SolidType

Matt__W 发表于 2010-12-22 09:12:19

ACAD2006 VBA确定Acad3dSolid SolidType

任何人都知道如何确定Acad3D实体的实体类型（solidtype）
我的代码在绿线上失败。SolidTypePublic Function IsSphereTorus(oObject As AcadObject) as boolean
    IsSphereTorus = false
    Dim oSphere As Acad3DSolid
    If TypeOf oObject Is Acad3DSolid Then
      Set oSphere = oObject
      If oSphere.SolidType = "Sphere" Or oSphere.SolidType = "Torus" Then
             IsSphereTorus = true
      End If
    End If
End Function
每个帮助。SolidType仅输入…那么现在我该怎么办？

Matt__W 发表于 2010-12-22 09:30:22

注意到有什么问题吗？

Matt__W 发表于 2010-12-22 10:40:31

其余的代码看起来像什么
我很快就把它拼凑起来了
Option Explicit
Public Const AppName = "VBA | 3D Solid"
Public Sub Main()
    Dim Entity As AcadEntity
    Dim Point As Variant
    Dim objObject As Acad3DSolid
    On Error GoTo ErrMsg
    ThisDrawing.Utility.GetEntity Entity, Point, "Select a 3D Solid: "
    If TypeOf Entity Is Acad3DSolid Then
      Set objObject = Entity
      If IsSphereTorus(objObject) = True Then
            MsgBox "Type of entity: " & objObject.SolidType, vbExclamation + vbOKOnly, AppName
      Else
            MsgBox "FAIL!", vbExclamation + vbOKOnly, AppName
      End If
    End If
    Exit Sub
   
ErrMsg:
    If Err.Number = "-2147352567" Then
      MsgBox "You didn't pick anything.Please try again.", vbExclamation + vbOKOnly, AppName
    Else
      MsgBox Err.Description & vbCrLf & Err.Number, vbCritical + vbOKOnly, AppName
      Debug.Print Err.Number
      Err.Clear
    End If
End Sub
Public Function IsSphereTorus(oObject As AcadObject) As Boolean
    IsSphereTorus = False
    Dim oSphere As Acad3DSolid
    If TypeOf oObject Is Acad3DSolid Then
      Set oSphere = oObject
      If oSphere.SolidType = "Sphere" Or oSphere.SolidType = "Torus" Then
             IsSphereTorus = True
      End If
    End If
End Function 只需将其复制/粘贴到模块中，然后运行MAIN sub。

Matt__W 发表于 2010-12-22 11:15:07

我的测试代码只是测试每个is函数的最简单方法
Public Sub Test_SphereTorus()
    Set oAcadDoc = ThisDrawing
    Dim oEllipse As AcadEllipse
    Dim oEnt As AcadEntity
    Dim oSphere As Acad3DSolid
    Dim oPoint As Variant
    Set oEnt = oAcadDoc.ModelSpace.AddSphere(MakePoint(0, 0, 0), 5)
    Set oSphere = oEnt
    MsgBox IsSphereTorus(oSphere)
End Sub
Public Function MakePoint(ByVal X As Double, ByVal Y As Double, ByVal Z As Double)
   
    Dim dCoordinate(0 To 2) As Double
   
    dCoordinate(0) = X
    dCoordinate(1) = Y
    dCoordinate(2) = Z
   
    MakePoint = dCoordinate
End Function
远程代码将是遇到或重新遇到的所有模型空间项的条件循环或按需调用&nbsp；IsLine、IsCircle、IsEllipse、IsEllipseOpen等（所有2D对象都很容易识别），剩下的是3D实体、IsSphere、IsCube、IsCylinder等；多段线和样条曲线最难识别，但在我们的图形中没有使用，因此无关紧要&nbsp
IS函数是我全部代码各个部分的组成部分&nbsp；起点/终点/中心点在不同类型的实体/对象之间不同，对象捕捉行为由传递的对象控制
例如，如果我想基于其他传递的几何体自动生成OSnap中心，我必须知道所述几何体是圆形还是球体，如果圆形eRetVal是对象。中心，如果球体eRetval是object.centroid&nbsp；因此，如果对象是Box或圆柱体类型，则返回其他内容
另一个例子，如果在椭圆上寻找可用的捕捉点，我有IsEllipse和IsEllipseOpen…如果IsEllipse只有中心点和长度，则有开始/结束（&E）；中心点可用。

Matt__W 发表于 2010-12-22 11:37:24

你能为MakePoint发布你的代码吗？

Matt__W 发表于 2010-12-22 13:07:58

出于好奇，你想用这个做什么&nbsp；你的代码是创建一个球体，然后你&#039；重新测试，看看它是否#039；s是一个球体&nbsp；你已经知道了；s是一个球体
；

Matt__W 发表于 2010-12-22 13:56:35

查看下面的图片&nbsp；第一个是用代码创建的球体的属性&nbsp；第二个是从“实体”工具栏创建的球体的属性
那里&#039；这是你的答案
现在进入下一个问题……为什么要这样创建？

Matt__W 发表于 2010-12-22 14:38:46

我在2008年做了我的，所以它#039；这也不是固定不变的。

Matt__W 发表于 2010-12-22 15:03:46

是的，我在VB Watch窗口中注意到了相同的结果，比较了菜单绘制和自动绘制之间的实体参数&nbsp；It#039；s不是球体#039；要么……它&#039；与其他三维实体的行为相同
简单的答案是：；在ACAD2000中进行测试时，无论采用何种绘制方法，都会产生相同的属性结果-两者均失败；因此，ACAD2006中的VBA尚未针对AddSphere等例程进行更新，以使用新版本手动绘制3DObjects
Go freak&#039；在图中，感谢Autodesk
现在我想起了为什么我使用Inventor进行三维建模；编程…：realmad:要使测试用例工作，请替换oacaddoc.modelspace。用oacaddoc添加实体…
。SendCommand“；球体“&amp；vbCr&amp&引用；0,0,0“&amp；vbCr&amp&引用；5,0,0“&amp；vbCr
设置object/entity/ospere=oacaddoc.modelspace.item（thisdrawing.modelspace.count-1）
对于我的完整代码，我现在必须永久保留遇到/绘制的每个3DSolid的objectID，以便以后可以引用它们…很好…我猜我&#039；我将创建一个跟踪对象类，啊&nbsp；%&amp；（$%^*&amp；^）_*$Autodesk感谢Matt帮助我证明了我希望的另一个不足之处&#039；t正确；

查看完整版本: ACAD2006 VBA确定Acad3dSolid SolidType