Hi all

I am trying to work out the code to break the link from projected geometry
from one sketch to another.

I can not see a method to do it. At this stage all I can do is identify the ref
geometry and give the user the option to delete it.

Can anyone help me out with the code to break the link from projected geometry.


Below is my current code


Sub Delete_Selected_Ref_Geometry()
Dim Found As Boolean
Dim f_type_chk As Boolean

Dim oapp As Inventor.Application
On Error Resume Next
Set oapp = GetObject(, "Inventor.Application")
If Err Then
MsgBox Err.Description
Err.Clear
Exit Sub
End If

If oapp.ActiveEnvironment.InternalName <> "PMxPartSketchEnvironment" Then
MsgBox "You Must Editing a sketch to use this command", vbInformation, "Delete Reference Geometry"
Exit Sub
End If

oapp.CommandManager.StopActiveCommand

Dim ODoc As Document
Set ODoc = oapp.ActiveDocument

Dim OSelectSet As SelectSet
Set OSelectSet = ODoc.SelectSet

If OSelectSet.Count = 0 Then
MsgBox "Select the sketch items first", vbInformation, "Delete Reference Geometry"
Exit Sub
End If


Dim OSSItem As Variant

Dim oGeometry_SelSet As ObjectCollection
Set oGeometry_SelSet = oapp.TransientObjects.CreateObjectCollection


' Create a new highlight set for the start face(s).
Dim oStartHLSet As HighlightSet
Set oStartHLSet = ThisApplication.ActiveDocument.HighlightSets.Add

' Change the highlight color for the set to red.
Dim oRed As Color
Set oRed = ThisApplication.TransientObjects.CreateColor(255, 0, 0)

' Set the opacity
oRed.Opacity = 0.8

oStartHLSet.Color = oRed

Dim response As Variant

For Each OSSItem In OSelectSet

If OSSItem.Type = kSketch3DObject Or _
OSSItem.Type = kSketchLine3DObject Or _
OSSItem.Type = kSketchPoint3DObject Or _
OSSItem.Type = kSketchArc3DObject Or _
OSSItem.Type = kSketchSpline3DObject Or _
OSSItem.Type = kSketchFixedSpline3DObject Or _
OSSItem.Type = kSketchEllipse3DObject Or _
OSSItem.Type = kSketchEllipticalArc3DObject Or _
OSSItem.Type = kSketchCircle3DObject Or _
OSSItem.Type = kSketchLineObject Or _
OSSItem.Type = kSketchPointObject Or _
OSSItem.Type = kSketchArcObject Or _
OSSItem.Type = kSketchSplineObject Or _
OSSItem.Type = kSketchEllipseObject Or _
OSSItem.Type = kSketchEllipticalArcObject Or _
OSSItem.Type = kSketchCircleObject Then
f_type_chk = True
Else
f_type_chk = False
End If


If f_type_chk = True Then
If OSSItem.Reference = True Then
Debug.Print "ref found"
Found = True
oStartHLSet.AddItem OSSItem
response = MsgBox("Reference geometry has been found." & Chr(13) & "Do you want to delete this item?", vbYesNo, "Delete Reference Geometry")

If response = vbYes Then ' User chose Yes.
oStartHLSet.Clear
OSSItem.Delete
Else
oStartHLSet.Clear

End If
End If
End If



Next

If Found = False Then
MsgBox "No Reference geometry found in your selection.", vbInformation, "Delete Reference Geometry"
End If


oStartHLSet.Delete
Set oRed = Nothing
Set oStartHLSet = Nothing

ODoc.Update
oapp.CommandManager.StopActiveCommand

End Sub