Ma ktoś makro, które pozwala otworzyć WSZYSTKIE rysunki podzespołów i części z głównego zespołu? Rysunki mają taki sam numer jak jego odniesienie.
Witam
Spróbuj wykonać następujące czynności:
Option Explicit
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.ModelDoc2
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim fileerror As Long
Dim filewarning As Long
Dim i As Long
Dim nRetval As Long
Dim myCmps As Variant
Dim myCmp As Component2
Dim myName As String
Sub main()
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAssy = Assembly
myCmps = myAssy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
Set swModel = myCmp.GetModelDoc2
myName = swModel.GetPathName
myName = Left(myName, (Len(myName) - 7)) & ".slddrw"
Set swDraw = swApp.OpenDoc6(myName, swDocumentTypes_e.swDocDRAWING, swOpenDocOptions_Silent, "", fileerror, filewarning)
myAssy.EditAssembly
Next i
Set Assembly = swApp.ActivateDoc2(myAssy.GetPathName, True, nRetval)
MsgBox "Traitement terminé", vbExclamation
End Sub
Pozdrowienia
3 polubienia
Witam;
Mam małe pytanie do naszego doktora S Macro d.roger nationnal.
Dlaczego zdecydowałeś się wypełnić zmienną "myName" ciągiem "=swmodel.getplathName"
zamiast z "= myCmps(i). GetPathName"?
Nie rozumiem tego wyboru.
Z drugiej strony reszta jest jak zwykle, prosta, precyzyjna, skuteczna.... Dobra robota.
Pozdrowienia.
1 polubienie