Hello. I'm wondering if anyone knows of or can write a VBA routine that will allow you to select a work plane in the browser and find all sketches that are defined by it. We do extensive skeletal modelling and our master parts consist of many sketches and sketch planes
Note, I am aware of the VBA routine that allows you to select a sketch and highlight the plane or surface that it is made off of.
Thanks all...
Well, I know this isn't the answer you are looking for, but a dirty solution would be to delete the Workplane in question. You'll be prompted to delete dependent sketches - and they'll all highlight in the browser. Cancel or Undo could quickly become your new best friends!
I know exactly what you want - I miss it myself. Unfortunately I cannot help you - but I was very interested in the code you already have found.
Could you please point me in the direction where I can find the VBA to select a sketch and find its sketchplane ?
Hmmm... actually this will probably work just fine (and I should have thought of this myself).
Thanks for the reminder...
Hello
I used the VBA routine as provided here:
Works great!
Thanks a lot - the code works as a charm 🙂
Used that code as a basis and made a routine that does what you initially wanted - finding all sketches defined by a selected plane:
Public Sub FindSketchesOnPlane()
Dim ODoc As Document
Set ODoc = ThisApplication.ActiveDocument
'Check to make sure a single plane is selected.
If ODoc.SelectSet.Count > 0 Then
If (ODoc.SelectSet.Item(1).Type <> kWorkPlaneObject) Then
MsgBox "A Workplane must be selected first."
Exit Sub
End If
Else
MsgBox "A Workplane must be selected first."
Exit Sub
End If
Dim wPlane As WorkPlane
Dim SMessage As String
SMessage = ""
Set wPlane = ODoc.SelectSet.Item(1)
Dim oSketch As PlanarSketch
For Each oSketch In ODoc.ComponentDefinition.Sketches
If Not (oSketch.PlanarEntity Is Nothing) Then
If oSketch.PlanarEntity.Type = kWorkPlaneObject Then
If (oSketch.PlanarEntity.Name = wPlane.Name) Then
'found a sketch using selected plane as sketch plane
Debug.Print "FOUND: " & oSketch.Name
SMessage = SMessage & oSketch.Name & Chr$(13)
ODoc.SelectSet.Select oSketch
End If
End If
End If
Next
If SMessage <> "" Then
MsgBox SMessage, , "Skeches"
Else
MsgBox "The Work plane is not used as sketch plane", , "Sketches"
End If
End Sub