ACAD2006VBA确定Acad3dSolid SolidType
任何人都知道如何确定Acad3DSolid的Solid Type（Solid type）。我的代码在绿线上失败。SolidType
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
每个帮助。SolidType仅输入...所以现在我该怎么办？
**** Hidden Message ***** 注意到什么不对劲吗？ 你剩下的代码看起来像什么？
我很快就做好了这些。
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。
我的测试代码只是测试每个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
长程代码将是一个条件循环或按需调用所有遇到或重新遇到的ModelSpace项。IsLine、IsCircle、IsEllipse、IsEllipseOpen等（所有二维对象都很容易识别），剩下的都是三维实体、IsSphere、IsCube、IsCylinder等。多段线和样条线最难识别，但在我们的图形中没有使用，因此不相关。
IS函数是我整个代码的各个部分的组成部分。起点/终点/中心点在不同类型的实体/对象之间有所不同，OSnap行为由传递的对象控制
例如，如果我想基于其他传递的几何体自动生成OSnap中心，我必须知道所述几何体是圆形还是球体，圆形是否为对象。中心，如果球体eRetval是object.centroid。因此，如果对象是Box或Cylinder类型，则返回其他对象
另一个例子是，如果在椭圆上寻找可用的捕捉点，我有IsEllipse和IsEllipseOpen…如果IsEllipse只有中心点和长度，则有可用的起点/终点和中心点。 您可以发布MakePoint的代码吗？ 只是出于好奇，你想用它来完成什么？您的代码正在创建一个球体，然后您正在测试它是否是一个球体。您已经知道它是一个球体。
查看下面的图片。第一个是用代码创建的球体的属性。第二个是从“实体”工具栏创建的球体的属性
现在进入下一个问题……为什么要以这种方式创建它？ 我在2008年做了我的，所以它也没有固定在那里。
是的，我注意到在VB监视窗口中比较菜单绘制和自动绘制的实体参数时有相同的结果。这也不是Sphere独有的...其他3d实体也有同样的行为。
简单的答案是:无论使用哪种绘制方法，ACAD2000中的测试都会产生相同的属性结果-都失败；因此，ACAD2006中的VBA尚未针对AddSphere等例程进行更新，以使用新版本手动绘制3d对象。
去怪胎的数字，感谢Autodesk！
现在我想起了为什么我使用Inventor进行3D建模和编程... :realmad:
要使测试用例工作，请替换
oacaddoc . model space . addshpere...废话连篇或者。getentity...关于oacaddoc的废话。SendCommand "sphere" & vbCr & "0，0，0" & vbCr & "5，0，0 " & vbCr
set object/entity/Osh pere = oacaddoc . model space . item(this drawing . model space . count-1)
对于我的完整代码，我现在必须永久保留遇到/绘制的每个3d实体的objectID，以便我可以在以后引用它们...可爱的...我想我会创建一个跟踪对象类，唉！%&($%^*&^)_*$ Autodesk
感谢Matt帮助我证明了另一个我希望不是真的不足之处
页:
[1]