Een macro toepassen op een hele map

Macro
1

Hallo

Ik wil graag de volgende macro toepassen die goed werkt op alle clips die in een map zijn opgeslagen.

Ik heb verschillende pogingen gedaan zonder succes, wetende dat ik een beginner ben en ik probeer bestaande modellen te kopiëren.

Bij voorbaat dank voor uw antwoord


2022-04-29_15h07_54.png
2 

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Public CheckCurV As String
Dim RevTable As Object
Dim CurrentRevision As String

Sub MAIN()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc


  
' Get Current Revision
  CheckCurV = Part.CustomInfo2("", "Current Revision")
  
  
' Get Revision Table
  Set RevTable = Part.GetCurrentSheet.RevisionTable
  If RevTable Is Nothing Then MsgBox "No revision table is available!", vbExclamation: End

' Add Row to Revision Table
  RevTable.AddRevision (CheckCurV)
    nNumCol = RevTable.ColumnCount - 4
    'nNumRow = RevTable.RowCount - 1

' Interface to add values to new row on the Revision Table
  RevTable.Text(0, nNumCol) = "28.04.22" 'InputBox("Date." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  'RevTable.Text(0, nNumCol + 1) = InputBox("Enter the Revision number or letter." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  RevTable.Text(0, nNumCol + 2) = "Changement de matiere en 441" 'InputBox("Enter the description of the revision." & Chr$(13) & Chr$(13) & "|Rev| *DESCRIPTION* |Rev By|Date|" & Chr$(13) & "____________________________________________", "Description", "ECO- ")

  RevTable.Text(0, nNumCol + 3) = "YP" 'InputBox("Enter the revision creator's initials." & Chr$(13) & Chr$(13) & "|Rev|Description| *REV BY* |Date|" & Chr$(13) & "____________________________________________", "Rev By", "IP")

' Apply new value for Current Revision
  Part.CustomInfo2("", "Current Revision") = RevTable.Text(nNumRow, nNumCol)

' Force Rebuild
  boolstatus = Part.ForceRebuild3(False)

End Sub

 

1 like
3

Hallo
U kunt dit doen met Integratie als u de MyCadTools heeft.

Zo niet met de code, dan moet je daarmee beginnen.

4

Bedankt, ik heb de MyCadTools-integratie gebruikt

1 like