Hoi allemaal
Ik heb hulp nodig om een macro te maken, omdat mijn kennis op dit gebied bijna niet bestaat, worstel ik vanaf de eerste stap.
Meestal lukt het me zo goed en zo kwaad als het gaat door stukken van rechts en links te kopiëren, maar hier kan ik niets vinden dat er in ieder geval voor het begin op lijkt.
Het doel van de macro is om bepaalde eigenschappen van de douane van een onderdeel naar een assembly te kopiëren.
1 - Voorwaarde: deel uitmaken van een vergadering
2 - Definieer het geselecteerde onderdeel in de bouwboom als de bron van de eigenschappen.
3 - Lees de eigenschap "REFERENCE" van het geselecteerde onderdeel
4 - Toon de waarde van het onroerend goed en heb de keuze om door te gaan of te annuleren
5 - Schrijf de eigenschap "REFERENCE" in de huidige assembly
6 - einde
Voorlopig zit ik vast bij stap 2 omdat ik niet weet hoe de te gebruiken functie genoemd kan worden.
Als iemand me in de goede richting kan wijzen,
Bij voorbaat dank.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set SwModel = swApp.ActiveDoc 'on récupére le document actif
' Vérifie qu'il s'agit d'un assemblage
If SwModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 "Ne Fonctionne qu'avec un ASSEMBLAGE!", swMbWarning, swMbOk
Exit Sub
End If
End Sub
Hallo
Voor punt 2 en 3 kunt u de volgende code gebruiken:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Debug.Print ValOut
Debug.Print ResolvedValOut
End If
End Sub
Vriendelijke groeten
1 like
Hallo weer,
Voor punt 4 kunt u de volgende code gebruiken:
Dim Rep As Integer
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
' ici le traitement si réponse positive
' ...
Else
' ici le traitement si réponse négative
' ...
End If
Vriendelijke groeten
1 like
Hallo weer,
Dus hier is een voorbeeld voor de punten 2 - 3 - 4 - 5 en 6:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelComp As SldWorks.Component2
Dim swSelModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim Retval As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
If Not swSelComp Is Nothing Then
Set swSelModel = swSelComp.GetModelDoc2
Set swModelDocExt = swSelModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Get5("REFERENCE", False, ValOut, ResolvedValOut, wasResolved)
Else
MsgBox "Aucune sélection."
Exit Sub
End If
Dim Rep As Integer
Dim result As String
Rep = MsgBox("Voulez-vous renseigner la valeur " & ResolvedValOut & " dans l'assemblage ?", vbYesNo + vbQuestion, "Ma macro")
If Rep = vbYes Then
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModelDocExt.CustomPropertyManager("")
Retval = swCustPropMgr.Delete2("REFERENCE")
Retval = swCustPropMgr.Add2("REFERENCE", swCustomInfoText, ResolvedValOut)
result = "Modification effectuée."
Else
result = "Aucune modification effectuée."
End If
MsgBox result
End Sub
Vriendelijke groeten
2 likes
Opnieuw -.......
Een beetje extra informatie, de geselecteerde component moet in de opgeloste modus staan, anders werkt het niet, dan moet u deze component in de opgeloste modus zetten voor de regel "Set swModelDocExt = swSelModel.Extension" die in de "If Not swSelComp Is Nothing Then" staat.
Vriendelijke groeten
1 like
Hallo @d.roger
bedankt voor je hulp, ik kijk er deze week naar,
@d. Roger,
Ik had niet veel tijd vandaag, maar ik zal meer vragen hebben :-)
Hallo allemaal,
Ik ben terug met mijn vragen,
Is er een oplossing om meerdere aangepaste eigenschappen op te halen zonder het aantal variabelen "Retval, ValOut ... "Evenveel?
Mijn andere vraag is of het mogelijk is om de kopieereigenschappen toe te passen op alle configuraties van de assembly, ongeacht de naam van de configuraties.
Bij voorbaat dank,
Goedenacht.
Hallo
" Is er een oplossing om meerdere aangepaste eigenschappen op te halen zonder het aantal variabelen te vermenigvuldigen" Retval, ValOut ... "Evenveel? ": Ja, je moet doorgaan met het lezen van aangepaste eigenschappen en degene waarin je geïnteresseerd bent toevoegen aan een array, zie HIER.
" Mijn andere vraag is of het mogelijk is om de kopieereigenschappen toe te passen op alle configuraties van de assembly, ongeacht de naam van de configuraties. ": Ja, je moet ook een lus maken op de configuraties van de assembly waarin je je code plaatst om eigenschappen te maken, zie HIER voor de functie om de configuraties weer te geven.
Vriendelijke groeten
1 like
Hallo @ d.roger,
Bedankt voor de info voor de site "développez.com", die me goed zal helpen, dat weet ik zeker.
Vriendelijke groeten.
Hallo
Omdat de stilte op het werk snel voorbij was, had ik geen tijd om door te gaan met de macro, ik kreeg het laatste antwoord van @D.Roger als oplossing omdat de voorgestelde links erg interessant zijn.
Ik hoop de macro snel af te kunnen maken,