×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Mass unselect of "Mark for Drawing"

Mass unselect of "Mark for Drawing"

Mass unselect of "Mark for Drawing"

(OP)
I am looking for a way to unselect all dimensions that are selected as "Mark for Drawing". I only need about a dozen dimension for my automated print, but part of the automated print generation is the importing of model items. Since I use a lot of weldments, all of the dimensions for the profiles are coming in as well as some other non-critical dimensions.

I guess I need a macro that cycles through all sketches in a model, if I had that, I could probably add my portion to it. I can then go back an manually add the ones that I want (far fewer than doing it the other way!).


Thanks!
Joe

RE: Mass unselect of "Mark for Drawing"

This code will traverse the part and open all sketches related to features for editing.  It will then fix all points in the sketch and rebuild, which exits the sketch editing mode.  Not exactly what you're looking for, but it will traverse all sketches.  You'll want to change the point fixing code to dimension un-marking code.  

CODE

Dim swApp As Object
Dim part As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim myFeature As SldWorks.Feature
Dim Component As Object
Dim Body As Object
Dim Face As Object
Dim bStatus As Boolean
Dim iCount As Integer
Dim sFeatName As String
Dim iNumFeat As Long

Sub main()

Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc

iNumFeat = part.GetFeatureCount
Set myFeature = part.FirstFeature
For iCount = 1 To iNumFeat
    If Not myFeature.IsSuppressed Then
        If myFeature.GetTypeName = "ProfileFeature" Then
            myFeature.Select False
            part.InsertSketch2 True
            Call FixThePoints(myFeature.GetSpecificFeature2, part)
            part.EditRebuild3
        End If
    End If
    Set myFeature = myFeature.GetNextFeature
Next iCount
part.ClearSelection
End Sub

Sub FixThePoints(mySketch As SldWorks.Sketch, part As SldWorks.ModelDoc2)
Dim MyPointArray As Variant
Dim myPoint As SldWorks.SketchPoint
Dim myRelMgr As SldWorks.SketchRelationManager
Dim dummyRel As SldWorks.SketchRelation
Dim mySelMgr As SldWorks.SelectionMgr
Dim mySketchSegArray As Variant
Dim mySeg As SketchSegment
Dim myArc As SketchArc
Dim i As Long

'First we fix all the sketch points
MyPointArray = mySketch.GetSketchPoints
mySketchSegArray = mySketch.GetSketchSegments
Set myRelMgr = mySketch.RelationManager
Set mySelMgr = part.SelectionManager

part.ClearSelection
    If Not IsEmpty(MyPointArray) Then
    For i = 0 To UBound(MyPointArray)
        Set myPoint = MyPointArray(i)
        myPoint.Select True
    Next i
End If
part.SketchAddConstraints "sgFIXED"
'Any partial arc will already be fixed by its center point
'and its end points.  Circles, however, only have one point.
'Therefore we fix all complete circles
part.ClearSelection
If Not IsEmpty(mySketchSegArray) Then
    For i = 0 To UBound(mySketchSegArray)
        Set mySeg = mySketchSegArray(i)
        If mySeg.GetType = swSketchARC Then
            Set myArc = mySeg
            If myArc.IsCircle = 1 Then 'Test whether it is complete circle
                mySeg.Select True
            End If
        End If
    Next i
End If
part.SketchAddConstraints "sgFIXED"
End Sub

RE: Mass unselect of "Mark for Drawing"

(OP)
Handleman, thanks for the help. I didn't end up using your code, but it put me on the right path. There was actually two items in API help that got to my final code: "Iterate through dimensions in model example" and "Determine if Display Dimension Marked for Drawing Example". Here is the code that will blast through the model and set all dimensions to Un-Marked For Drawing:

Sub main()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swFeat                  As SldWorks.Feature
    Dim swSubFeat               As SldWorks.Feature
    Dim swDispDim               As SldWorks.DisplayDimension
    Dim swDim                   As SldWorks.Dimension
    Dim swAnn                   As SldWorks.Annotation
    Dim bRet                    As Boolean

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swFeat = swModel.FirstFeature
    

    Debug.Print "File = " & swModel.GetPathName

    Do While Not swFeat Is Nothing

        Debug.Print "  " + swFeat.Name

        Set swSubFeat = swFeat.GetFirstSubFeature

        Do While Not swSubFeat Is Nothing

            Debug.Print "      " + swSubFeat.Name

            Set swDispDim = swSubFeat.GetFirstDisplayDimension

            Do While Not swDispDim Is Nothing

                Set swAnn = swDispDim.GetAnnotation

                Set swDim = swDispDim.GetDimension

                

                Debug.Print "          [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")

                Set swDispDim = swSubFeat.GetNextDisplayDimension(swDispDim)
            Loop
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop

        Set swDispDim = swFeat.GetFirstDisplayDimension

        Do While Not swDispDim Is Nothing

            Set swAnn = swDispDim.GetAnnotation

            Set swDim = swDispDim.GetDimension
            
            swDispDim.MarkedForDrawing = False

            Debug.Print "    [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")
            Debug.Print " Marked For Drawing    =" & swDispDim.MarkedForDrawing
                      
            Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
        Loop
        Set swFeat = swFeat.GetNextFeature
    Loop
End Sub




Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources