TheSwamp
Code Red => VB(A) => Topic started by: bsardeson on December 22, 2010, 09:12:19 AM
-
Anyone know how to determine the Solid Type (solidtype) of an Acad3DSolid.
My code fails on the green line with .SolidType
Public Function IsSphereTorus(oObject As AcadObject) as boolean
IsSphereTorus = false
Dim oSphere As Acad3DSolid
If TypeOf oObject Is Acad3DSolid Then
Set oSphere = oObject
[color=green]If oSphere.SolidType = "Sphere" Or oSphere.SolidType = "Torus" Then[/color]
IsSphereTorus = true
End If
End If
End Function
per help .SolidType is input only ... so now what do I do?
-
Anyone know how to determine the Solid Type (solidtype) of an Acad3DSolid.
My code fails on the green line with .SolidType
Public Function IsSphereTorus([color=red]oObject[/color] As AcadObject) as boolean
IsSphereTorus = false
Dim oSphere As Acad3DSolid
If TypeOf oObject Is Acad3DSolid Then
Set oSphere = [color=red]oSnapObject[/color] [color=green]If oSphere.SolidType = "Sphere" Or oSphere.SolidType = "Torus" Then[/color]
IsSphereTorus = true
End If
End If
End Function
Notice anything wrong?
-
What does the rest of your code look like?
I threw this together real quick.
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
Just copy/paste into a module and run the MAIN sub.
-
My testcode is nothing but the simplest method of testing each IS function.
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
Long range code will be a conditional loop or on demand call of all ModelSpace Items as encountered or re-encountered. IsLine, IsCircle, IsEllipse, IsEllipseOpen, etc (all 2D objects easily identified) and all that remain are the 3DSolids, IsSphere, IsCube, IsCylinder etc. Polylines and splines the hardest to identify, but not used in our drawings, so irrelevant.
The IS functions are integral to various parts of my total code. Start/end/center points differ between types of entities/objects, OSnap behavior is controlled by the object passed.
For instance, if I want to Automate the OSnap-Center based on other passed geometry, I have to know if said geometry is a circle or sphere, if circle eRetVal is object.center, if Sphere eRetval is object.centroid. Therefore, if object is of type Box or Cylinder, I return something else.
Another instance, if looking for available snap points on an Ellipse, I have IsEllipse and IsEllipseOpen ... eRetval if IsEllipse only have center point and lengths, if IsEllipseOpen, have start/end & center points available.
-
Can you post your code for MakePoint?
-
Just out of curiosity, what are you trying to accomplish with this? Your code is creating a sphere and then you're testing to see if it's a sphere. You already KNOW it's a sphere.
:?
-
Check out the images below. The first one is the properties of the sphere created with your code. The second one is the properties of a sphere created from the solids toolbar.
There's your answer.
Now on to the NEXT question.... Why is it being created this way?
-
I did mine in 2008 so it's not fixed there either.
-
Check out the images below. The first one is the properties of the sphere created with your code. The second one is the properties of a sphere created from the solids toolbar.
There's your answer.
Yes, I noticed the same results in the VB Watch window comparing the Entity parameters between Menu Drawn and autoDrawn. It's not unique to Sphere's either ... it's the same behavior with the other 3DSolids as well.
Now on to the NEXT question.... Why is it being created this way?
The simple answer: Testing in ACAD2000 produces the same property results regardless of draw method - both fail; therefore, the VBA in ACAD2006 has not been updated for the AddSphere, etc routines to use the new version for manual draw 3DObjects.
Go freak'in figure, thanks Autodesk!
I did mine in 2008 so it's not fixed there either.
Now I remember why I use Inventor for 3D Modelling & Programming ... :realmad:
to make the test case work, replace
oacaddoc.modelspace.addshpere ... blah blah or .getentity ... blah blah
with
oacaddoc.SendCommand "sphere" & vbCr & "0,0,0" & vbCr & "5,0,0" & vbCr
set object/entity/oshpere = oacaddoc.modelspace.item(thisdrawing.modelspace.count -1)
For my full code, I now must permanently preserve the objectID for every 3DSolid encountered/drawn so I can reference them later ... lovely ... guess I'll create a tracking object class, ugh! %&($%^*&^)_*$ Autodesk
Thanks Matt for helping me prove another inadequacy I was hoping wasn't true :cry: