Macro: mi aiutate a crearne una semplice che cambia materiale e aspetto alle parti?

reggio

Utente Senior
Professione: ...
Software: autocad11+swx16 sp4 w7 x64+Ready2W2016
Regione: Emilia - Modena
Ciao, mi ritrovo con un assieme iges di un cliente da cui ricavo assieme e parti SW ma aspetti e materiali si sono persi, quindi a manina, uno per uno stò assegnando materiale e cambiando aspetto (colore) ...

Ho provato a registrare una macro, ma quando la rilancio con l'intenzione di applicare gli stessi passaggi ad una nuova parte, ovviamente la macro mi ripete le operazioni sulla parte originale ... :(

Credete sia abbastanza semplice spiegarmi come modificare questa macro per fare in modo che ad ogni lancio, la macro chieda di selezionare la (o magari anche più di una?) parte a cui applicare le modifiche?
 

MassiVonWeizen

Utente Senior
Professione: disegnatore
Software: solidworks 2019
Regione: Friuli Venezia Giulia
Perché non ti crei un modello con materiale già impostato (col colore non so se funziona) e quando importi il modello usi quel template?
 

MassiVonWeizen

Utente Senior
Professione: disegnatore
Software: solidworks 2019
Regione: Friuli Venezia Giulia
Vake anche per il colore. Dato il materiale ai nella scheda aspetto e modifichi. Salvi e buona importazione
 

reggio

Utente Senior
Professione: ...
Software: autocad11+swx16 sp4 w7 x64+Ready2W2016
Regione: Emilia - Modena
... troppo facile ...
quando importo ottengo dei corpi e dei sottoassiemi di corpi e mica tutto deve diventare acciaio giallo, su un esempio di 100 corpi/sottoassiemi avremo
65% di acciaio - giallo
20% lamiera zincata - zincata
5% polizene - nero
5% C40 tornito - rosso
5% Commerciali & varie

volevo crearmi 2/3 macro per assegnare velocizzando ...

... dici che non è così semplice da spiegare ... a mè?
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Prova questa, la copi e te ne crei quante te ne servono in base ai materiali che vuoi associare.
Prerequisiti:
- File di assieme aperto
- Preseleziona una o più componenti (basta che clicchi sopra a una faccia del componente, Ctrl premuto per multi selezione, come si fa di solito)
- Lancia la macro

Modifica la macro a piacere cambiando il materiale da associare, se ti va bene il colore del materiale di SolidWorks commenti (in gergo di programmazione vuol dire mettere l'apice) sulle righe che non ti interessano)altrimenti lo cambi il colore da associare sulle prime 3 righe del RetVar(0) = 1 (sarebbere il valore dell'RGB diviso per 255)





'Associa Colore Rosso e 1.5714 (16NiCr4)
Dim swApp As SldWorks.SldWorks
Dim ModelDoc2 As SldWorks.ModelDoc2
Dim swCompModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vMatProp As Variant
Dim bRet As Boolean
Dim longstatus As Long, longwarnings As Long
Global Const swDocPART = 1
Global Const swDocAsm = 2
Dim RetVar As Variant
Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
MsgBox "Nessun documento caricato." + Chr$(10) + Chr$(13) _
+ "Carica un file di parte o assieme."
Exit Sub
End If

FileTyp = ModelDoc2.GetType
If FileTyp = swDocPART Then
ModelDoc2.MaterialPropertyValues = RetVar
ModelDoc2.EditRebuild3
End If

If FileTyp = swDocAsm Then
Set swModel = swApp.ActiveDoc

Dim i As Integer
Dim selCount As Integer

Set swSelMgr = swModel.SelectionManager
selCount = swSelMgr.GetSelectedObjectCount()
If selCount > 0 Then

For i = 1 To swSelMgr.GetSelectedObjectCount()
Set swSelObj = swSelMgr.GetSelectedObject5(i)
Set swComp = swSelMgr.GetSelectedObjectsComponent2(i)
Set swCompModel = swComp.GetModelDoc

Dim PartDoc As SldWorks.PartDoc
Set PartDoc = swComp.GetModelDoc
'CAMBIARE DICITURA MATERIALE A SECONDA DELL'ESIGENZA, SE SERVE ANCHE IL PERCORSO DELLA LIBRERIA
PartDoc.SetMaterialPropertyName2 "Default", "C:/Program Files/SOLIDWORKS Corp/SOLIDWORKS/lang/italian/sldmaterials/SolidWorks DIN Materials.sldmat", "1.5714 (16NiCr4)"

'NEL CASO NON SI VOLESSE FORZARE IL COLORE DEL MATERIALE COMMENTARE IL CODICE FINO A "FINE COMMENTO"
'QUESTA PARTE ASSOCIA IL COLORE ROSSO ALLA PARTE INDIFFERENTEMENTE DAL COLORE DEL MATERIALE IMPOSTATO NELLA SCHEDA MATERIALE SI SOLIDWORKS
vMatProp = swComp.MaterialPropertyValues
If IsEmpty(vMatProp) Then
If swCompModel Is Nothing Then
Exit Sub
End If
vMatProp = swCompModel.MaterialPropertyValues
End If
RetVar = PartDoc.MaterialPropertyValues

RetVar(0) = 1
RetVar(1) = 0
RetVar(2) = 0
RetVar(3) = 1
RetVar(4) = 1
RetVar(5) = 1
RetVar(6) = 0.31
RetVar(7) = 0
RetVar(8) = 0

PartDoc.MaterialPropertyValues = RetVar
'"FINE COMMENTO"
PartDoc.Save2 True
Next
End If
swModel.ClearSelection2 True
End If
End Sub
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Ciao, ho trovato questa discussione a seguito di una ricerca.

Non sono riuscito a farla funzionare, ho escluso (spero correttamente) il cambio di colore, ma il resto non mi funziona, allego il testo della macro da me modificata, se hai tempo jenuary, puoi darmi un occhio?

Ti ringrazio!

'Associa Colore Rosso e 1.5714 (16NiCr4)
Dim swApp As SldWorks.SldWorks
Dim ModelDoc2 As SldWorks.ModelDoc2
Dim swCompModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vMatProp As Variant
Dim bRet As Boolean
Dim longstatus As Long, longwarnings As Long
Global Const swDocPART = 1
Global Const swDocAsm = 2
Dim RetVar As Variant
Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
MsgBox "Nessun documento caricato." + Chr$(10) + Chr$(13) _
+ "Carica un file di parte o assieme."
Exit Sub
End If

FileTyp = ModelDoc2.GetType
If FileTyp = swDocPART Then
ModelDoc2.MaterialPropertyValues = RetVar
ModelDoc2.EditRebuild3
End If

If FileTyp = swDocAsm Then
Set swModel = swApp.ActiveDoc

Dim i As Integer
Dim selCount As Integer

Set swSelMgr = swModel.SelectionManager
selCount = swSelMgr.GetSelectedObjectCount()
If selCount > 0 Then

For i = 1 To swSelMgr.GetSelectedObjectCount()
Set swSelObj = swSelMgr.GetSelectedObject5(i)
Set swComp = swSelMgr.GetSelectedObjectsComponent2(i)
Set swCompModel = swComp.GetModelDoc

Dim PartDoc As SldWorks.PartDoc
Set PartDoc = swComp.GetModelDoc
'CAMBIARE DICITURA MATERIALE A SECONDA DELL'ESIGENZA, SE SERVE ANCHE IL PERCORSO DELLA LIBRERIA
PartDoc.SetMaterialPropertyName2 "Default", "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\italian\sldmaterials/solidworks materials.sldmat", "AISI 316L"


"vMatProp = swComp.MaterialPropertyValues
If IsEmpty(vMatProp) Then
If swCompModel Is Nothing Then
Exit Sub
End If
vMatProp = swCompModel.MaterialPropertyValues
End If
RetVar = PartDoc.MaterialPropertyValues

RetVar(0) = 1
RetVar(1) = 0
RetVar(2) = 0
RetVar(3) = 1
RetVar(4) = 1
RetVar(5) = 1
RetVar(6) = 0.31
RetVar(7) = 0
RetVar(8) = 0

PartDoc.MaterialPropertyValues = RetVar"
'"FINE COMMENTO"
PartDoc.Save2 True
Next
End If
swModel.ClearSelection2 True
End If
End Sub
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Cosi dovrebbe andare

'Associa Colore Rosso e 1.5714 (16NiCr4)
Dim swApp As SldWorks.SldWorks
Dim ModelDoc2 As SldWorks.ModelDoc2
Dim swCompModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vMatProp As Variant
Dim bRet As Boolean
Dim longstatus As Long, longwarnings As Long
Global Const swDocPART = 1
Global Const swDocAsm = 2
Dim RetVar As Variant
Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
MsgBox "Nessun documento caricato." + Chr$(10) + Chr$(13) _
+ "Carica un file di parte o assieme."
Exit Sub
End If

FileTyp = ModelDoc2.GetType
If FileTyp = swDocPART Then
ModelDoc2.MaterialPropertyValues = RetVar
ModelDoc2.EditRebuild3
End If

If FileTyp = swDocAsm Then
Set swModel = swApp.ActiveDoc

Dim i As Integer
Dim selCount As Integer

Set swSelMgr = swModel.SelectionManager
selCount = swSelMgr.GetSelectedObjectCount()
If selCount > 0 Then

For i = 1 To swSelMgr.GetSelectedObjectCount()
Set swSelObj = swSelMgr.GetSelectedObject5(i)
Set swComp = swSelMgr.GetSelectedObjectsComponent2(i)
Set swCompModel = swComp.GetModelDoc

Dim PartDoc As SldWorks.PartDoc
Set PartDoc = swComp.GetModelDoc
'CAMBIARE DICITURA MATERIALE A SECONDA DELL'ESIGENZA, SE SERVE ANCHE IL PERCORSO DELLA LIBRERIA
PartDoc.SetMaterialPropertyName2 "Default", "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\italian\sldmaterials/solidworks materials.sldmat", "AISI 316L"


'vMatProp = swComp.MaterialPropertyValues
'If IsEmpty(vMatProp) Then
'If swCompModel Is Nothing Then
'Exit Sub
'End If
'vMatProp = swCompModel.MaterialPropertyValues
'End If
'RetVar = PartDoc.MaterialPropertyValues

'RetVar(0) = 1
'RetVar(1) = 0
'RetVar(2) = 0
'RetVar(3) = 1
'RetVar(4) = 1
'RetVar(5) = 1
'RetVar(6) = 0.31
'RetVar(7) = 0
'RetVar(8) = 0

'PartDoc.MaterialPropertyValues = RetVar"
'"FINE COMMENTO"
PartDoc.Save2 True
Next
End If
swModel.ClearSelection2 True
End If
End Sub
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Si, funziona, grazie mille!

Sarebbe anche interessante che il colore che è stato assegnato alla parte fosse mantenuto dopo il cambio.
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Quello fa parte del colore del materiale nella libreria di SolidWorks.
Altrimenti va memorizzato a inizio macro, si cambia il materiale (quindi il colore cambia) e poi si sovrascrive il colore con quello memorizzato all'inizio.
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Quello fa parte del colore del materiale nella libreria di SolidWorks.
Altrimenti va memorizzato a inizio macro, si cambia il materiale (quindi il colore cambia) e poi si sovrascrive il colore con quello memorizzato all'inizio.
E fare questa cosa è possbile?
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Prova



'Associa 1.5714 (16NiCr4), il colore rimane lo stesso
Dim swApp As SldWorks.SldWorks
Dim ModelDoc2 As SldWorks.ModelDoc2
Dim swCompModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vMatProp As Variant
Dim bRet As Boolean
Dim longstatus As Long, longwarnings As Long
Global Const swDocPART = 1
Global Const swDocAsm = 2
Dim RetVar As Variant
Dim RetVar_Old As Variant

Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
MsgBox "Nessun documento caricato." + Chr$(10) + Chr$(13) _
+ "Carica un file di parte o assieme."
Exit Sub
End If
FileTyp = ModelDoc2.GetType
If FileTyp = swDocPART Then
ModelDoc2.MaterialPropertyValues = RetVar
ModelDoc2.EditRebuild3
End If
If FileTyp = swDocAsm Then
Set swModel = swApp.ActiveDoc
Dim i As Integer
Dim selCount As Integer
Set swSelMgr = swModel.SelectionManager
selCount = swSelMgr.GetSelectedObjectCount()
If selCount > 0 Then
For i = 1 To swSelMgr.GetSelectedObjectCount()
Set swSelObj = swSelMgr.GetSelectedObject5(i)
Set swComp = swSelMgr.GetSelectedObjectsComponent2(i)
Set swCompModel = swComp.GetModelDoc
Dim PartDoc As SldWorks.PartDoc
Set PartDoc = swComp.GetModelDoc
RetVar_Old = PartDoc.MaterialPropertyValues
'CAMBIARE DICITURA MATERIALE A SECONDA DELL'ESIGENZA, SE SERVE ANCHE IL PERCORSO DELLA LIBRERIA
PartDoc.SetMaterialPropertyName2 "Default", "C:/Program Files/SOLIDWORKS Corp/SOLIDWORKS/lang/italian/sldmaterials/SolidWorks DIN Materials.sldmat", "1.5714 (16NiCr4)"
'NEL CASO NON SI VOLESSE FORZARE IL COLORE DEL MATERIALE COMMENTARE IL CODICE FINO A "FINE COMMENTO"
'QUESTA PARTE ASSOCIA IL COLORE ROSSO ALLA PARTE INDIFFERENTEMENTE DAL COLORE DEL MATERIALE IMPOSTATO NELLA SCHEDA MATERIALE SI SOLIDWORKS
vMatProp = swComp.MaterialPropertyValues
If IsEmpty(vMatProp) Then
If swCompModel Is Nothing Then
Exit Sub
End If
vMatProp = swCompModel.MaterialPropertyValues
End If
RetVar = PartDoc.MaterialPropertyValues
RetVar(0) = RetVar_Old(0)
RetVar(1) = RetVar_Old(1)
RetVar(2) = RetVar_Old(2)
RetVar(3) = RetVar_Old(3)
RetVar(4) = RetVar_Old(4)
RetVar(5) = RetVar_Old(5)
RetVar(6) = RetVar_Old(6)
RetVar(7) = RetVar_Old(7)
RetVar(8) = RetVar_Old(8)
PartDoc.MaterialPropertyValues = RetVar
'"FINE COMMENTO"
PartDoc.Save2 True
Next
End If
swModel.ClearSelection2 True
End If

End Sub
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
No, cambia il materiale e anche il colore originale...
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
:eek: Non dovrebbe, l'ho testato!
Sei sicuro?
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Eh si, ho provato più volte, cambia il materiale in "1.5714 (16NiCr4) " e non mantiene il colore che ho impostato io manualmente. Forse è questo l'inghippo? Il colore che ho io non è il colore std del materiale ma un colore a caso che immetto io.
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Prova adesso, in effetti poi non ha funzionato neanche a me!o_O

Dim swApp As SldWorks.SldWorks
Dim ModelDoc2 As SldWorks.ModelDoc2
Dim swCompModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vMatProp As Variant
Dim bRet As Boolean
Dim longstatus As Long, longwarnings As Long
Global Const swDocPART = 1
Global Const swDocAsm = 2
Dim RetVar As Variant
Dim RetVar_old As Variant
Sub Main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
MsgBox "Nessun documento caricato." + Chr$(10) + Chr$(13) _
+ "Carica un file di parte o assieme."
Exit Sub
End If
FileTyp = ModelDoc2.GetType
If FileTyp = swDocPART Then
ModelDoc2.MaterialPropertyValues = RetVar
ModelDoc2.EditRebuild3
End If
If FileTyp = swDocAsm Then
Set swModel = swApp.ActiveDoc
Dim i As Integer
Dim selCount As Integer
Set swSelMgr = swModel.SelectionManager
selCount = swSelMgr.GetSelectedObjectCount()
If selCount > 0 Then
For i = 1 To swSelMgr.GetSelectedObjectCount()
Set swSelObj = swSelMgr.GetSelectedObject5(i)
Set swComp = swSelMgr.GetSelectedObjectsComponent2(i)
Set swCompModel = swComp.GetModelDoc
Dim PartDoc As SldWorks.PartDoc
Set PartDoc = swCompModel

RetVar_old = PartDoc.MaterialPropertyValues
'
'CAMBIARE DICITURA MATERIALE A SECONDA DELL'ESIGENZA, SE SERVE ANCHE IL PERCORSO DELLA LIBRERIA
PartDoc.SetMaterialPropertyName2 "Default", "C:/Program Files/SOLIDWORKS Corp/SOLIDWORKS/lang/italian/sldmaterials/SolidWorks DIN Materials.sldmat", "1.5714 (16NiCr4)"

'NEL CASO NON SI VOLESSE FORZARE IL COLORE DEL MATERIALE COMMENTARE IL CODICE FINO A "FINE COMMENTO"
'QUESTA PARTE ASSOCIA IL COLORE ROSSO ALLA PARTE INDIFFERENTEMENTE DAL COLORE DEL MATERIALE IMPOSTATO NELLA SCHEDA MATERIALE SI SOLIDWORKS
vMatProp = PartDoc.MaterialPropertyValues
If IsEmpty(vMatProp) Then
If swCompModel Is Nothing Then
Exit Sub
End If
'vMatProp = swCompModel.MaterialPropertyValues
End If
RetVar = PartDoc.MaterialPropertyValues
RetVar(0) = RetVar_old(0)
RetVar(1) = RetVar_old(1)
RetVar(2) = RetVar_old(2)
RetVar(3) = 1
RetVar(4) = 1
RetVar(5) = 1
RetVar(6) = 0.31
RetVar(7) = 0
RetVar(8) = 0
PartDoc.MaterialPropertyValues = RetVar
'"FINE COMMENTO"
PartDoc.Save2 True
Next
End If
swModel.ClearSelection2 True
End If
End Sub
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Ancora non mi funziona...
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Cos'è che fa ? Da errore o non fa nulla o colora o non colora?
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Avevo provato con un assieme con due componenti, uno di questi era senza materiale e la parte era colorata di rosso (la parte colorata, il corpo e le facce non avevano colore, altrimenti il colore esterna viene comandato da facce e corpo).
Avevo preselezionato la faccia di un componente e lanciato la macro, il componente ha cambiato di materiale e mantenendo il colore rosso.
A te non fa così?
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Solidworks 2020, Autocad 2018 e occasionalmente Inventor 2017
Regione: Italia
Scusa se ti rispondo solo ora.

Io ho già i materiali e i colori assegnati da me. Cambia il materiale e mette il colore di default del materiale.
 

jenuary

Utente Standard
Professione: Progettista e Programmatore VB.Net
Software: Solidworks
Regione: Veneto
Scusami non vorrei fraintendere.
Tu vuoi che il materiale venga cambiato ma non il colore, deve mantenere quello prima del cambio di materiale, giusto?