Easy way to find extra features?
Easy way to find extra features?
(OP)
I was just wondering if there was a quick way to find childless features that sometimes accumulate in large models. Things like extra planes, sketches, etc.
-b
-b
When was the last time you drove down the highway without seeing a commercial truck hauling goods?
Download nowINTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS Come Join Us!Are you an
Engineering professional? Join Eng-Tips Forums!
*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail. Posting GuidelinesJobs |
Easy way to find extra features?
|
RE: Easy way to find extra features?
There is no command per se that can do this.
However, there is a best practice that I do for modeling...
When there is a feature one likes, and one knows it will be used, put it in a folder. That way when you are finished creating a model anything in the feature tree that is not in a folder, can be deleted.
cheers,
RE: Easy way to find extra features?
Jeff Mirisola, CSWP
http://designsmarter.typepad.com/jeffs_blog
Dell M90, Core2 Duo
4GB RAM
Nvidia 3500M
RE: Easy way to find extra features?
[code]' ******************************************************************************
' C:\TEMP\swx266\Macro1.swb - macro recorded on 08/13/02 by Chen
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Sub deleteplanes()
Dim SubFeatObj As Object
Dim FeatObj As Object
Dim FeatType As String
Dim retval As Variant
Set FeatObj = Part.FirstFeature
Do While Not FeatObj Is Nothing
FeatType = FeatObj.GetTypeName
If FeatType = "RefPlane" And FeatObj.Name <> "Front" _
And FeatObj.Name <> "Top" And FeatObj.Name <> "Right" _
Then 'a sketch - select it
retval = FeatObj.GetChildren()
If IsEmpty(retval) Then
Part.AndSelectByID FeatObj.Name, "PLANE", 0, 0, 0
End If
End If
Set FeatObj = FeatObj.GetNextFeature
Loop
Part.DeleteSelection (False)
End Sub
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
If (Part Is Nothing) Then
swApp.SendMsgToUser2 _
"No Active Part !! " _
, swMbWarning, swMbOk
Exit Sub
End If
If (Part.GetType <> 1) Then ' If not an assembly or parts, then
exit
swApp.SendMsgToUser2 "Only for use with parts.", swMbWarning,
swMbOk
Exit Sub
End If
Set SelMgr = Part.SelectionManager() ' Get the selection manager
object
Part.ClearSelection
Call deleteplanes
End Sub [\code]
Hope it helps
Pete