Selecting a McadAuto MCSURFACE or Autocad AcadPolyline

Selecting a McadAuto MCSURFACE or Autocad AcadPolyline

Anonymous
Not applicable
441 Views
6 Replies
Message 1 of 7

Selecting a McadAuto MCSURFACE or Autocad AcadPolyline

Anonymous
Not applicable
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
0 Likes
442 Views
6 Replies
Replies (6)
Message 2 of 7

Anonymous
Not applicable
Comment out every line that says 'On Error Resume Next' and you will get
your errors.

"Keith" wrote in message
news:[email protected]...
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
0 Likes
Message 3 of 7

Anonymous
Not applicable
Technically, you're correct. I added On Error Goto 0 after the error
checking I had. That resets the error handler. Thanks to you pointing out
that oversight, I see my error is in the line

Set geom = util.GetGeometryFromPick(mcGeometry, False, pick)

I get a "Failed to create object reference" error.

Am I approaching this task in the right direction or do I need to get a
reference to the BrepEntity or something else?

My INTENT is this:

The user will create something which represents a rectangle, either 4 lines,
1 rectangular polyline (Design | Rectangle), or a planar surface (could be
planar trim). I want to pick whatever entity is there: either the surface,
polyline, or one of the lines. Based on what type of entity I pick, I need
to get the X and Y values of two opposing corners or prompt for a second
pick (only if a line is picked). If I pick the surface or polyline, I want
to get the bounding box of the surface or polyline. If I pick a line, I
want to get the nearest endpoint and then prompt for another pick.

I can pick the entity using either the Mcad object OR the Autocad object but
I don't know how to convert the picked entity to and from the different
object models, depending on what is picked.

Please help, even if you work for Autodesk. This cannot be that hard for
one who knows what they're doing. Please.

Keith
0 Likes
Message 4 of 7

Anonymous
Not applicable
Hi Keith,

It sounds like you need the dreaded "CreatePickObject" method. It is fatally
flawed. It could be me, but every time I try the method I get the "blue
screen of death". Brian Ekins tried to get it to work for me about a year
ago. He said that he got the same errors and logged it as a bug against
MDT4. I don't think it got fixed in MDT5. I don't know of any other way to
transform a pick object from one type to another.

>>I don't know how to convert the picked entity to and from the different
object models, depending on what is picked.

Gary
0 Likes
Message 5 of 7

Anonymous
Not applicable
Thanks, Gary, I'll look into that.

Gary McMaster wrote in message
news:[email protected]...
> Hi Keith,
>
> It sounds like you need the dreaded "CreatePickObject" method. It is
fatally
> flawed. It could be me, but every time I try the method I get the "blue
> screen of death". Brian Ekins tried to get it to work for me about a year
> ago. He said that he got the same errors and logged it as a bug against
> MDT4. I don't think it got fixed in MDT5. I don't know of any other way to
> transform a pick object from one type to another.
>
> >>I don't know how to convert the picked entity to and from the different
> object models, depending on what is picked.
>
> Gary
>
0 Likes
Message 6 of 7

Anonymous
Not applicable
I found something to do it. I'm using the GetObjectFromID method. Cool!

' select geometry representing the blank
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
Dim pt1 As Variant
Dim pt2 As Variant
If EntType = "AcAsSurfBody" Then
' surface picked, get dimensions
Dim mapp As McadApplication
Dim util As McadUtility
Set mapp =
thisdrawing.Application.GetInterfaceObject("Mcad.Application")
Set util = mapp.ActiveDocument.Utility
Dim geom As IMcadSurface
Set geom = util.GetObjectFromID(returnObj.ObjectID, mcSurface)
pt1 = geom.BRepEntity.BoundingBlock.MinPoint
pt2 = geom.BRepEntity.BoundingBlock.MaxPoint
' compensate because Autocad subtracts .001 from each value of the
MinPoint
pt1(0) = pt1(0) + 0.001
pt1(1) = pt1(1) + 0.001
pt1(2) = pt1(2) + 0.001
' compensate because Autocad adds .001 to each value of the MaxPoint
pt2 = geom.BRepEntity.BoundingBlock.MaxPoint
pt2(0) = pt2(0) - 0.001
pt2(1) = pt2(1) - 0.001
pt2(2) = pt2(2) - 0.001
ElseIf EntType = "acPolylineLight" Then
returnObj.GetBoundingBox pt1, pt2
ElseIf EntType = "acPolyline" Then
MsgBox "acPolyline"
Exit Sub
ElseIf EntType = "acLine" Then
If IsGroupMember(returnObj) Then
MsgBox returnObj.StartPoint(0) & ", " & returnObj.StartPoint(1)
MsgBox returnObj.EndPoint(0) & ", " & returnObj.EndPoint(1)
End If
pt1 = SnapToNearestEndpoint(basePnt, returnObj)

Exit Sub
End If

Function SnapToNearestEndpoint(pnt As Variant, ent As AcadEntity) As Variant
If CalculateDistance(pnt, ent.EndPoint) > CalculateDistance(pnt,
ent.StartPoint) Then
SnapToNearestEndpoint = ent.StartPoint
Else
SnapToNearestEndpoint = ent.EndPoint
End If
End Function

Function IsGroupMember(obj As AcadObject) As Boolean
Dim grp As AcadGroup
Dim i As Integer
IsGroupMember = False
For Each grp In thisdrawing.Groups
For i = 0 To grp.count - 1
If grp.item(i).ObjectID = obj.ObjectID Then
IsGroupMember = True
End If
Next
Next
End Function

Keith wrote in message
news:[email protected]...
> Thanks, Gary, I'll look into that.
>
> Gary McMaster wrote in message
> news:[email protected]...
> > Hi Keith,
> >
> > It sounds like you need the dreaded "CreatePickObject" method. It is
> fatally
> > flawed. It could be me, but every time I try the method I get the "blue
> > screen of death". Brian Ekins tried to get it to work for me about a
year
> > ago. He said that he got the same errors and logged it as a bug against
> > MDT4. I don't think it got fixed in MDT5. I don't know of any other way
to
> > transform a pick object from one type to another.
> >
> > >>I don't know how to convert the picked entity to and from the
different
> > object models, depending on what is picked.
> >
> > Gary
> >
>
0 Likes
Message 7 of 7

Anonymous
Not applicable
Glad you got it. Thanks for sharing it.

Gary
0 Likes