Makro -- editace poznamek

Makro -- editace poznamek

Příspěvekod Aleš » úte 04. úno 2014 2:53:22

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?


Kód: Vybrat vše
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
Aleš
 
Příspěvky: 93
Registrován: pon 18. črc 2011 21:05:27

Re: Makro -- editace poznamek

Příspěvekod jucas » úte 04. úno 2014 10:53:42

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ášť.
jucas
 
Příspěvky: 12
Registrován: stř 11. lis 2009 12:19:57

Re: Makro -- editace poznamek

Příspěvekod Aleš » úte 04. úno 2014 18:08:31

Díky, jdu to zkusit :-)
Aleš
 
Příspěvky: 93
Registrován: pon 18. črc 2011 21:05:27

Re: Makro -- editace poznamek

Příspěvekod Aleš » stř 05. úno 2014 19:16:22

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.


Kód: Vybrat vše
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
Aleš
 
Příspěvky: 93
Registrován: pon 18. črc 2011 21:05:27


Zpět na Ostatní

Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 2 návštevníků


cron