Téma: Makro — editace poznamek - MůjSolidworks.cz

Nevyzná se tu prosím někdo v makrech? Stáhl jsem si z netu jakési makro a pokusil se ho upravit tak, aby ve všech poznámek ve výkresu zaměnilo text „Nazev“ za „Name“. Ale nejenom, že to nic nezamění, ještě mi to vymění proměnnou za její hodnotu (například z poznámky ‚$PRPMODEL:“Nazev“‚ to udělá ‚Hřídel‘) a ještě navrch to vytvoří několik prázdných poznámek rozsypaných ve výkresu. Co s tím?

Option Explicit



Sub main()

Dim swApp           As SldWorks.SldWorks

Dim swModel         As SldWorks.ModelDoc

Dim swDraw          As SldWorks.DrawingDoc

Dim swView          As SldWorks.View

Dim swNote          As SldWorks.Note

Dim sNoteText       As String

Dim nTextCount      As Long

Dim i               As Long

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swDraw = swModel

Set swView = swDraw.GetFirstView

While Not swView Is Nothing

Set swNote = swView.GetFirstNote

While Not swNote Is Nothing

sNoteText = swNote.GetText

sNoteText = Replace(sNoteText, "Nazev", "Name", 1, -1, vbTextCompare)

swNote.SetText sNoteText

Set swNote = swNote.GetNext

Wend

Set swView = swView.GetNextView

Wend

End Sub

Metody GetText / SetText pracují s výsledným vyhodnoceným textem. Pro přístup k definičnímu řetězci je nutno použít metodu PropertyLinkedText. Pokud se mají nahradit jen řetězce v adrese properties nebo běžný text, je nutno to ošetřit v kódu zvlášť.

Díky, jdu to zkusit 🙂

Funguje to! Dík 🙂 Některé příkazy sice moc nechápu, ale to asi není nutné 🙂

Takhle to nakonec vypadá, makro zamění všechny výskyty „Nazev“ za „Name“ ve všech poznámkách.

Option Explicit



Sub main()

Dim swApp           As SldWorks.SldWorks

Dim swModel         As SldWorks.ModelDoc

Dim swDraw          As SldWorks.DrawingDoc

Dim swView          As SldWorks.View

Dim swNote          As SldWorks.Note

Dim sNoteText       As String

Dim nTextCount      As Long

Dim i               As Long

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swDraw = swModel

Set swView = swDraw.GetFirstView

While Not swView Is Nothing

Set swNote = swView.GetFirstNote

While Not swNote Is Nothing

sNoteText = swNote.PropertyLinkedText

sNoteText = Replace(sNoteText, "Nazev", "Name")

swNote.PropertyLinkedText = sNoteText

Set swNote = swNote.GetNext

Wend

Set swView = swView.GetNextView

Wend

End Sub