Message 1 of 7
Selecting a McadAuto MCSURFACE or Autocad AcadPolyline
Not applicable
04-26-2001
06:24 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I want my users to select geometry which represents an electrode blank. The
geometry might be a McadAuto mcSurface entity or an Autocad AcadLine or
AcadPolyline. I can select one or the other, but I'm trying to determine
how to reference either to obtain the bounding box, regardless of what type
of entity is selected.
I marked the code in the last snippet that gives me no results, not even an
error. Can anyone help with direction?
Thanks, Keith
My code to get the entity type:
Sub GetElectrode()
Dim returnObj As AcadObject
Dim basePnt As Variant
On Error Resume Next
thisdrawing.Utility.GetEntity returnObj, basePnt, "Select an object
which represents the electrode blank size: "
If Err <> 0 Then
Err.Clear
MsgBox "Nothing selected", , "Error: ODM Dimension Electrode"
Exit Sub
End If
returnObj.Color = acRed
returnObj.Update
returnObj.Color = acByLayer
returnObj.Update
Dim EntType As String
EntType = GetEntityType(returnObj)
Err.Clear
On Error Resume Next
MsgBox EntType
End Sub
' watch for wrapping
Function GetEntityType(ent As AcadObject) As String
Dim pt As Variant
Dim entTypeConstant As String
On Error Resume Next
If ent.EntityType = "" Then
GetEntityType = ent.ObjectName
Else
GetEntityType = Choose(ent.EntityType, "ac3dFace", "ac3dPolyline",
"ac3dSolid", "acArc", "acAttribute", "acAttributeReference",
"acBlockReference", "acCircle", "acDimAligned", "acDimAngular", "reserved",
"acDimDiametric", "acDimOrdinate", "acDimRadial", "acDimRotated",
"acEllipse", "acHatch", "acLeader", "acLine", "reserved", "acMtext",
"acPoint", "acPolyline", "acPolylineLight", "acPolymesh", "acRaster",
"acRay", "acRegion", "acShape", "reserved", "acSpline", "acText",
"acTolerance", "acTrace", "acPViewport", "acXline", "acGroup", "", , "",
"AcadDim3PointAngular")
End If
End Function
Code to get the surface info:
Dim mapp As McadApplication
Dim util As McadUtility
Set mapp =
thisdrawing.Application.GetInterfaceObject("Mcad.Application")
Set util = mapp.ActiveDocument.Utility
On Error Resume Next
Dim pick As McadPick
Set pick = util.pick("Select geometry", mcGeometry)
If Err Then
MsgBox "Error: Pick" & vbCr & Err.Description
Err.Clear
End If
On Error Resume Next
Dim geom As IMcadGeometry
Set geom = util.GetGeometryFromPick(mcGeometry, False, pick)
If Err Then
MsgBox "Error: GetGeometryFromPick" & vbCr & Err.Description &
vbCr & vbCr & geom.BRepEntity.body.Faces.count
Err.Clear
End If
' these lines yield nothing, not even an error
MsgBox geom.BRepEntity.BoundingBlock.MinPoint(0)
MsgBox geom.BRepEntity.body.BoundingBlock.MinPoint(0)
Dim ln As AcadLine
If TypeOf geom Is McadPolyline Then
MsgBox "poly"
Else
'If TypeOf pick Is IMcadSurface Then
Set ln = geom
' this line give me nothing, too
MsgBox ln.StartPoint(0)
End If
geometry might be a McadAuto mcSurface entity or an Autocad AcadLine or
AcadPolyline. I can select one or the other, but I'm trying to determine
how to reference either to obtain the bounding box, regardless of what type
of entity is selected.
I marked the code in the last snippet that gives me no results, not even an
error. Can anyone help with direction?
Thanks, Keith
My code to get the entity type:
Sub GetElectrode()
Dim returnObj As AcadObject
Dim basePnt As Variant
On Error Resume Next
thisdrawing.Utility.GetEntity returnObj, basePnt, "Select an object
which represents the electrode blank size: "
If Err <> 0 Then
Err.Clear
MsgBox "Nothing selected", , "Error: ODM Dimension Electrode"
Exit Sub
End If
returnObj.Color = acRed
returnObj.Update
returnObj.Color = acByLayer
returnObj.Update
Dim EntType As String
EntType = GetEntityType(returnObj)
Err.Clear
On Error Resume Next
MsgBox EntType
End Sub
' watch for wrapping
Function GetEntityType(ent As AcadObject) As String
Dim pt As Variant
Dim entTypeConstant As String
On Error Resume Next
If ent.EntityType = "" Then
GetEntityType = ent.ObjectName
Else
GetEntityType = Choose(ent.EntityType, "ac3dFace", "ac3dPolyline",
"ac3dSolid", "acArc", "acAttribute", "acAttributeReference",
"acBlockReference", "acCircle", "acDimAligned", "acDimAngular", "reserved",
"acDimDiametric", "acDimOrdinate", "acDimRadial", "acDimRotated",
"acEllipse", "acHatch", "acLeader", "acLine", "reserved", "acMtext",
"acPoint", "acPolyline", "acPolylineLight", "acPolymesh", "acRaster",
"acRay", "acRegion", "acShape", "reserved", "acSpline", "acText",
"acTolerance", "acTrace", "acPViewport", "acXline", "acGroup", "", , "",
"AcadDim3PointAngular")
End If
End Function
Code to get the surface info:
Dim mapp As McadApplication
Dim util As McadUtility
Set mapp =
thisdrawing.Application.GetInterfaceObject("Mcad.Application")
Set util = mapp.ActiveDocument.Utility
On Error Resume Next
Dim pick As McadPick
Set pick = util.pick("Select geometry", mcGeometry)
If Err Then
MsgBox "Error: Pick" & vbCr & Err.Description
Err.Clear
End If
On Error Resume Next
Dim geom As IMcadGeometry
Set geom = util.GetGeometryFromPick(mcGeometry, False, pick)
If Err Then
MsgBox "Error: GetGeometryFromPick" & vbCr & Err.Description &
vbCr & vbCr & geom.BRepEntity.body.Faces.count
Err.Clear
End If
' these lines yield nothing, not even an error
MsgBox geom.BRepEntity.BoundingBlock.MinPoint(0)
MsgBox geom.BRepEntity.body.BoundingBlock.MinPoint(0)
Dim ln As AcadLine
If TypeOf geom Is McadPolyline Then
MsgBox "poly"
Else
'If TypeOf pick Is IMcadSurface Then
Set ln = geom
' this line give me nothing, too
MsgBox ln.StartPoint(0)
End If