问根据所选择的装配图中的部件从装配图中提取零件编号(CATIA VBA)

EN

Set oView = CATIA.ActiveDocument.DrawingRoot.ActiveSheet.Views.ActiveView
numtexts = oView.Texts.Count

'Change ToolsOptions so that balloons will be created with PartNumbers
'(Hint from DJakub)
Set settingRepository1 = CATIA.SettingControllers.Item("DraftingOptions")
settingValueBeforeChange = settingRepository1.GetAttr("DrwBalloonAssocMod")
settingRepository1.PutAttr "DrwBalloonAssocMod", 2 'Balloon creation with PartNumber

'Start Catia's Balloon command
CATIA.StartCommand "Balloon"

'Wait until user clicks somewhere
'(DrawingText with PartNumber will be added from Balloon command)
tic = Timer
Do
    DoEvents
    If oView.Texts.Count > numtexts Then
        'Get text and remove balloon
        Set oText = oView.Texts.Item(oView.Texts.Count)
        strPartNumber = oText.Text
        oView.Texts.Remove oView.Texts.Count
        
        Exit Do
    End If
    
    toc = Timer
Loop Until toc - tic > 10 'Exit loop after 10 seconds

'Exit Ballon command
SendKeys "{ESC}", True

'Reset setting to standard
settingRepository1.PutAttr "DrwBalloonAssocMod", settingValueBeforeChange

Sub CATMain()



'Sets drawing doc as active doc and makes sure a drawing is open
Dim draw_doc As DrawingDocument
On Error Resume Next
Set draw_doc = CATIA.ActiveDocument
If Err.Number <> 0 Then
    MsgBox "A drawing must be open to run this macro"
    End
End If
On Error GoTo 0



'Brings up macro instructions. The false sets the modal to false aka code runs with out messing with the form
Leader_Gen_With_Pt_Num_Inst.Show (False)



'Sets the view to be the current active view in CATIA
Set oView = CATIA.ActiveDocument.DrawingRoot.ActiveSheet.Views.ActiveView
'Stores the number of text associated with a view
numtexts = oView.Texts.Count



'Change Tools-->Options-->Drafting-->Annotation and Dress-up-->Balloon Creation so
'that balloons will be created with PartNumbers. Thanks DJakub!
Set settingRepository1 = CATIA.SettingControllers.Item("DraftingOptions")       'Set the options selection to drafting options
settingValueBeforeChange = settingRepository1.GetAttr("DrwBalloonAssocMod")     'The original user settings
settingRepository1.PutAttr "DrwBalloonAssocMod", 2                              'Balloon creation with PartNumber



'Start Catia's Balloon command
CATIA.StartCommand "Balloon"



'Dimension positioning variables
Dim i As Long
Dim x As Double
Dim y As Double
'Create drawing leader object
Dim draw_leader As DrawingLeader



'Sets the starting time for the timer for the variable tic
tic = Timer

Do

    DoEvents
    'Goes into the if statment when a text object has been added
    If oView.Texts.Count > numtexts Then
    
        'Get most recently create text in a text object
        Set oText = oView.Texts.Item(oView.Texts.Count)
        'Set a leader object to be the leader created from the balloon
        Set draw_leader = oText.Leaders.Item(oText.Leaders.Count)
        'Store the position of the leader in the doubles x and y
        draw_leader.GetPoint i, x, y
        'Store the part number in the string strpartnumber
        strpartnumber = oText.Text
        'Deletes the most recent text. Also deletes the leader since the text is its parent
        oView.Texts.Remove oView.Texts.Count
        Exit Do
    End If
    
    'Sets the end time for the timer to the variable toc
    toc = Timer
    
    'Since toc is the start and tic is the end, then toc minus tic means the timer will go to 8 seconds
    If toc - tic = 8 Then
        MsgBox "Ending macro since eight seconds have passed"
        'Ends program
        End
    End If
    
Loop Until toc - tic > 8 'Exit loop after 8 seconds

'Exit Ballon command
SendKeys "{ESC}", True



'Setting the CATIA command to select makes it so the balloon creation box doesn't appear when the user clicks away
CATIA.StartCommand "Select"



'Returns the ballon settings to what the user originally had
settingRepository1.PutAttr "DrwBalloonAssocMod", settingValueBeforeChange 'Will want to put this at the end of the main program



Dim draw_sheets As DrawingSheets            'Create drawing sheets collection
Set draw_sheets = draw_doc.Sheets           'Set the drawing sheets collection to be the collection for the drawing document
Dim draw_sheet As DrawingSheet              'Create drawing sheet object
Set draw_sheet = draw_sheets.ActiveSheet    'Makes that drawing sheet object the active sheet
'Dim draw_view As DrawingView                'Creates drawing view objec
Dim draw_leaders As DrawingLeaders          'Creates drawing leaders collection



'When something that is not a part in a drawing is clicked on, a numbered balloon is created
'So we cast the part number as an integer. When an error happens we know the user did not click on a random spot so we create the leader
'When an error is not thrown the user didn't click on the part, so we end the program and tell them what went wrong.
Dim test_int As Integer
On Error Resume Next
test_int = CInt(strpartnumber)
If Err.Number <> 0 Then

    On Error GoTo 0
    
    Dim part_number As String
    'part_number stores the part number value of strpartnumber that we got from the balloon
    part_number = strpartnumber
    'Repalce underscores with spaces
    part_number = Replace(part_number, "_", " ")
    Dim draw_texts As DrawingTexts              'Create drawing texts collection
    Set draw_texts = draw_sheet.Views.ActiveView 'Set the drawing texts to the avtive view
    Dim draw_text As DrawingText                'Make drawing text object
    'Set the drawing text and position we're goint to use for the leader
    'The text is set 40 mm over and 40 mm up from the leader arrow
    Set draw_text = oView.Texts.Add(part_number, x + 40, y + 40)
    'Create the leader with x and y position relative to the drawing view
    Set draw_leader = draw_text.Leaders.Add(x, y)

Else
    On Error GoTo 0
    'The message box actually doesn't run, but this code keeps the leader from being created if the user clicked a random spot
    MsgBox "You may have selected an item that is not an assembly part, so the program did not pull the part number"
    'Hides opened form
    Leader_Gen_With_Pt_Num_Inst.Hide
    End
End If



'Hides form once code has ran
Leader_Gen_With_Pt_Num_Inst.Hide



End Sub