Het haalt de bestaande informatie in de cartridge op en maakt updates mogelijk zonder alles handmatig te hoeven doen. Het werkt heel goed, maar als er maar één bord is.
Mijn probleem ligt in de duplicatie van deze informatie op een mogelijke 2e, 3e enz... plank, indien aanwezig. Wetende dat de noten van de basiskaart die op plaat 1 worden bijgewerkt, plotseling niet dezelfde naam zullen hebben op de toegevoegde platen.
Als iemand een idee heeft hoe het moet, ben ik er helemaal voor.
Is het een verlangen om niet dezelfde namen van de ene pagina naar de andere te hebben? Als dit niet het geval is, is de gemakkelijkste manier om eigenschappen aan deze notities te koppelen en dus werken we alleen de eigenschappen bij en ontvouwt het zich op de andere folio's
Nee, helemaal niet, dat is een observatie. Door het toevoegen van een nieuw bord in het MEP krijgen de nieuwe nota's niet dezelfde naam. het heet "Object van détail1137@Fond van plan1", maar op de nieuwe plaat is het "Object van détail1137@Fond van plan3", de naam van het blad verandert. en ik kon deze instellingen niet beheren.
Effectief gekoppeld aan een woning zou eigenlijk eenvoudiger zijn.
Allereerst moet je dus sjablonen maken voor de basiskaart en de tekening. Zodra dit is gebeurd, moeten de notities in de basiskaart die gerelateerd moeten zijn aan de tekening zelf als volgt worden geschreven: §PRP:xxxx (xxxx is de naam van de eigenschap) Het hebben van exact dezelfde achtergrondplannen en notities in alle paginaformaten (van A4 tot A0 bijvoorbeeld) vereenvoudigt de macro dus aanzienlijk. Je had dit ook kunnen doen in de editor van het eigenschapsformulier in plaats van via een macro denk ik.
Dim swApp als SldWorks.SldWorks Dim swModel als SldWorks.DrawingDoc Dim config As SldWorks.Configuration Dim swCustProp als SldWorks.CustomPropertyManager Dim lRetVal zo lang Dim vPropNames als variant Dim vPropTypes als variant Dim vPropValues als variant Dim ValOut als snaar Dim ResolvedValOut als tekenreeks Dim wasOpgelost als Booleaanse Dim linkToProp als Booleaanse Dim opgelost als variant Dim linkProp als variant Dim nNbrProps zo lang Zon j Zo lang Dim custPropType zo lang Dim bRet als Booleaanse
Sub mainTest()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set config = swModel.GetActiveConfiguration
' Stel cusPropMgr in = config. CustomPropertyManager
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Er is geen configuratie in de tekeningen. Kortom, de code zou deze zijn (ik heb de taak voorgekauwd door een verwerkingslus te plaatsen voor de toepassing van de wijzigingen)
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim swDraw As SldWorks.DrawingDoc
Dim bRet As Boolean
Dim iAddProp As Integer
Dim lretVal As Long
Dim sProp(11) As String
Sub Tableprop()
sProp(0) = "REV1": sProp(1) = "DATE1": sProp(2) = "NOM1": sProp(3) = "MODIF1"
sProp(4) = "REV2": sProp(5) = "DATE2": sProp(6) = "NOM2": sProp(7) = "MODIF2"
sProp(8) = "REV3": sProp(9) = "DATE3": sProp(10) = "NOM3": sProp(11) = "MODIF3"
End Sub
Sub mainTest()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Call Tableprop
For i = 0 To UBound(sProp)
If sProp(i) <> "" Then
lretVal = swCustProp.Set2(sProp(i), "yyy")
End If
Next i
End Sub
U moet verwerking toevoegen om de gegevens uit het formulier in een tabelvariabele op te halen en alle mogelijke gevallen af te handelen (lege velden, een veld controleren dat al is bijgewerkt met dezelfde waarde...) De "yyy" zou daarom moeten worden vervangen door de variabele array die de resultaten ophaalt.
Bedankt @Cyril_f voor je kostbare hulp, na een beetje onderzoek en koppigheid ben ik erin geslaagd om de volledige code aan het werk te krijgen.
Ik zet hieronder het deel van de code dat de Europarlementariër bijwerkt en haal de bestaande informatie in de Europarlementariër op.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim swDraw As SldWorks.DrawingDoc
Dim bRet As Boolean
Dim iAddProp As Integer
Dim lretVal As Long
Dim sProp(11) As String
Dim ValeursUsF(11) As String
Sub Tableprop()
sProp(0) = "REV1": sProp(1) = "DATE1": sProp(2) = "NOM1": sProp(3) = "MODIF1"
sProp(4) = "REV2": sProp(5) = "DATE2": sProp(6) = "NOM2": sProp(7) = "MODIF2"
sProp(8) = "REV3": sProp(9) = "DATE3": sProp(10) = "NOM3": sProp(11) = "MODIF3"
End Sub
Sub MajMEP()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Call Tableprop
Call TableValeurTableau
For i = 0 To UBound(sProp)
If sProp(i) <> "" Then
lretVal = swCustProp.Set2(sProp(i), ValeursUsF(i))
End If
Next i
End Sub
Sub TableValeurTableau()
'Chaque champs du userform
ValeursUsF(0) = TabRev.Bx0.Value: ValeursUsF(1) = TabRev.Bx1.Value: ValeursUsF(2) = TabRev.Bx2.Value: ValeursUsF(3) = TabRev.Bx3.Value
ValeursUsF(4) = TabRev.Bx4.Value: ValeursUsF(5) = TabRev.Bx5.Value: ValeursUsF(6) = TabRev.Bx6.Value: ValeursUsF(7) = TabRev.Bx7.Value
ValeursUsF(8) = TabRev.Bx8.Value: ValeursUsF(9) = TabRev.Bx9.Value: ValeursUsF(10) = TabRev.Bx10.Value: ValeursUsF(11) = TabRev.Bx11.Value
End Sub
Sub RecupValMEP()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Call Tableprop
Call TableValeurTableau
Dim Val As String
Dim resolved As Boolean
Dim Title As String
For i = 0 To UBound(sProp)
If sProp(i) <> "" Then
lretVal = swCustProp.Get5(sProp(i), False, ValeursUsF(i), Title, resolved)
End If
Next i
For i = 0 To UBound(ValeursUsF)
TabRev("Bx" & i).Value = ValeursUsF(i)
Next
End Sub
Leuk samenwerkingswerk. En bedankt voor het nadenken over deelname aan de voltooide macro. Het enige dat overblijft is het valideren van het beste antwoord, om dit onderwerp af te sluiten.
Geen zorgen over hulp. Aan de andere kant vind ik dat de code vereenvoudigd of op zijn minst geoptimaliseerd moet worden. Het initialiseren van de swApp-variabele in twee verschillende procedures kan een bug veroorzaken. Als er geen uitvoer van de hoofdprocedure is tussen het controleren van de waarden en het bijwerken, kan al deze code in de hoofdprocedure worden geplaatst:
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Call Tableprop
Call TableValeurTableau
Ik heb ook een beetje moeite om te begrijpen waar dit deel van de code voor is:
For i = 0 To UBound(sProp)
If sProp(i) <> "" Then
lretVal = swCustProp.Get5(sProp(i), False, ValeursUsF(i), Title, resolved)
End If
Next i
Ik begrijp niet echt wat je probeert te doen in dit stukje code, omdat het daarna niet meer wordt gebruikt.
Het is inderdaad behoorlijk te optimaliseren. Dat ga ik proberen te doen. Bedankt
Het tweede deel stelt me in staat om de waarden van de eigenschappen op te halen, in het geval van een reeds ingevuld plan, om ze weer te geven in mijn gebruikersformulier met de regel code die volgt.
For i = 0 To UBound(ValeursUsF)
TabRev("Bx" & i).Value = ValeursUsF(i)
Next
Het is misschien niet de beste methode, maar het heeft de verdienste dat het werkt.
In het voorbeeld zijn er
