'#Language "WWB-COM" 'CC-AT 2021 Pieter van der Hijden (pvdh@sofos.nl) 'Inspired by Software Tools by B. Kernighan and P. Plauger ' 'Lines are either command lines or text lines 'Command lines start with a special character: ' # = new topic, eg # central topic, ## main topic, ### subtopic etc until ###### ' ( = topic image, eg (filename | width (mm) | height (mm)) ' [ = topic hyperlink, eg [Sofos Consultancy](http://www.sofos.nl) ' : = topic property, eg :Country:Jordan: ' ! = topic marker, eg: !SDG-04-08-09-10 (group name - item label - item - label etc. 'All lines not being command lines are considered text lines ' ' Default directory = MM21 options: default document location (eg "G:\Mijn Drive\2021\") ' ' BEFORE YOU START the macro: ' Open a document (mindmap) with the style and markers you want to use ' Then start this macro ' ' INTERACTION during the run is limited to: ' - at the start: file open dialogue to select batch file ' - at the finish: dialogue box with batch file name and number of lines processed ' ' ERRORS ' - errors in the input file are neglected and/or may cause unexpected results ' - dynamic errors in the macro code will suspend macro execution ' - static errors in macro code will be signalled at the start and prevent execution ' ' To be considered: '- errors in the input file should be logged to STDERR ' 'Components: ' - Main ' - ProcessCommandLine ' - CheckHeading ' - FirstWord ' - CheckImage ' - CheckHyperlink ' - CheckProperty ' - CheckMarker ' - MMaddTopic ' - MMaddImage ' - MMaddHyperlink ' - MMaddProperty ' - MMaddMarker ' - ProcessTextLine ' - ProcessTextLine Option Explicit Sub MMaddTopic(iLevel, hLevel, hText, iPara1, iPara2, cTopic) ' case: hLevel > iLevel + 1 Debug.Print("case: hLevel > iLevel + 1") If hLevel > iLevel + 1 Then ' some heading level(s) are missing Debug.Print("Some levels are missing") iLevel = 0 Return End If ' case: hLevel < iLevel + 1 Debug.Print("case: hLevel < iLevel + 1") While hLevel < iLevel + 1 'one or more levels back towards root 'select father topic (TBD) Set cTopic = cTopic.ParentTopic iLevel = iLevel - 1 Wend 'now hLevel = iLevel +1, therefore continue with the next case ' case: hLevel = iLevel + 1 Debug.Print("case: hLevel = iLevel + 1") ' create new subtopic with hText If hLevel = 1 Then 'start a new map Set cTopic = ActiveDocument.CentralTopic cTopic.Document.ExportStyle(GetPath(mmDirectoryStyles)+"tmpstyle.mmas") cTopic.Document.ExportMapMarkers(GetPath(mmDirectoryMapMarkerLists)+"tmpmarkers.mmms") With VisibleDocuments.Add .AssignStyle(GetPath(mmDirectoryStyles)+"tmpstyle.mmas") .AssignMapMarkers(GetPath(mmDirectoryMapMarkerLists)+"tmpmarkers.mmms") .CentralTopic.Text = hText End With Set cTopic = ActiveDocument.CentralTopic ' If iPara1 = 1 Then ' central topic SubTopicsLayout ' If iPara2 >0 And iPara2 <=10 Then ' cTopic.SubTopicsLayout.CentralTopicGrowthDirection=iPara2 ' End If ' End If Debug.Print("letop:" + cTopic.Text) iLevel = iLevel + 1 Else Set cTopic = cTopic.AddSubTopic("") cTopic.Text = hText iLevel = iLevel + 1 End If End Sub Sub MMaddHyperlink(hypTitle, hypURL, cTopic) 'add a hyperlink to a topic Dim hTopic As Hyperlink Debug.Print(hypTitle) Debug.Print(hypURL) Set hTopic = cTopic.Hyperlinks.AddHyperlink(hypURL) hTopic.Title = hypTitle End Sub Sub MMaddProperty(propName, propValue, cTopic) 'add a property to a topic ' ensure that custom properties can be added If cTopic.DataContainer.DataContainerType = mmDataContainerTypeNone Then ' = 1 Debug.Print(cTopic.DataContainer.DataContainerType) cTopic.DataContainer.InsertCustomProperties() End If ' Note: Add Custom Property only adds the property identifier, visible name and format, NOT its value ' Note: Once propertu exists it can not be overwritte; set propertu value sets its value Debug.Print(cTopic.DataContainer.DataContainerType) ' = 4 cTopic.DataContainer.CustomProperties.CustomPropertyCollection.AddCustomProperty(propName, propName, mmCustomPropertyFormatTypeText) cTopic.DataContainer.CustomProperties.SetCustomPropertyValue(propName,CVar(propValue)) End Sub Sub MMaddMarker(mGroup, mItems, cTopic) 'add marker(s) to a topic ' does the mapmarkergroup exist? Debug.Print(ActiveDocument.MapMarkerGroups.Count) Debug.Print(ActiveDocument.MapMarkerGroups.IsValid) Dim Aux1 As String Dim Aux2 As String Dim myMMGroup As MapMarkerGroup Dim lmGroup As Integer 'length of mGroup name Dim mItemsArr () As String ' marker labels as array elements Dim i As Integer ' cursor Dim nMarkers 'number of markers in group Dim mMarker As MapMarker lmGroup = Len(mGroup) For Each myMMGroup In cTopic.Document.MapMarkerGroups Debug.Print(Left(myMMGroup.Name, lmGroup)) Debug.Print(mGroup) If Left(myMMGroup.Name, lmGroup) = mGroup Then 'Markergroup found Debug.Print("Markergroup Found") nMarkers = myMMGroup.Count 'count should be at least 1 mItemsArr = Split(mItems, "-") For i = LBound(mItemsArr) To UBound(mItemsArr) For Each mMarker In myMMGroup If InStr(mMarker.Label, mItemsArr(i)) = 1 Then Aux1 = mMarker.Icon.CustomIconSignature Aux2 = mMarker.Icon.Name Debug.Print("Aux1: " & Aux1) Debug.Print("Aux2: " & Aux2) cTopic.UserIcons.AddCustomIconFromMap(mMarker.Icon.CustomIconSignature) End If Next Next End If Next End Sub Sub MMaddImage(cImageFile, iPara1, iPara2, oTopic) Debug.Print(cImageFile) Debug.Print(iPara1) Debug.Print(iPara2) On Error Resume Next If oTopic.HasImage Then oTopic.Image.Load(cImageFile) Else oTopic.CreateImage(cImageFile) End If If oTopic.HasImage Then If oTopic.Image.IsValid Then oTopic.Image.Width = iPara1 oTopic.Image.Height = iPara2 End If End If End Sub Function FirstWord(DataLine) Return Mid(DataLine,1,InStr(DataLine,Space(1))-1) End Function Function CheckHeading(DataLine, hLevel, hText, iPara1, iPara2) Dim hComm As String Dim cComm As String Dim cArguments() As String Dim i As Integer iPara1 = 0 iPara2 = 0 hComm = String(6, "#") '6 times # char cComm = FirstWord(DataLine) ' first word If cComm = Left(hComm, Len(cComm)) Then ' first word consists of 1-6 # chars hLevel = Len(cComm) ' Set the heading level hText = Right(DataLine,Len(DataLine)-hLevel-1) 'set the heading title 'new ' cArguments = Split(hText, "|") ' hText = cArguments(0) ' For i = 0 To (UBound(cArguments)-1) ' Select Case i ' Case 0 ' hText = cArguments(0) ' Case 1 ' iPara1 = CInt(cArguments(1)) ' Case 2 ' iPara2 = CInt(cArguments(2)) ' End Select ' Next Debug.Print(cComm + ":" + Str(hLevel) + ":" + hText) Return True Else Return False End If End Function Function CheckHyperlink(DataLine, hypTitle, hypURL) Dim hypTitleLB As Integer Dim hypTitleUB As Integer Dim hypURLLB As Integer Dim hypURLUB As Integer If Left(DataLine, 1) <> "[" Then ' first character Is NOT Hyperlink delimiter ([) Return False End If hypTitleLB = InStr(1, DataLine, "[") If hypTitleLB > 0 Then ' candidate for hyperlink command hypTitleUB = InStr(hypTitleLB, DataLine, "]") If hypTitleUB > 0 Then hypURLLB = InStr(hypTitleUB, DataLine, "(") If hypURLLB > 0 Then hypURLUB = InStr(hypURLLB, DataLine, ")") If hypURLUB > 0 Then hypTitle=Mid(DataLine,hypTitleLB+1, hypTitleUB-hypTitleLB-1) hypURL=Mid(DataLine,hypURLLB+1, hypURLUB-hypURLLB-1) Debug.Print(hypTitle) Debug.Print(hypURL) Return True Else Return False End If Else Return False End If Else Return False End If Else Return False End If End Function Function CheckProperty(DataLine, propName, propValue) Dim dlDel As String dlDel = ":" Dim dlFields() As String dlFields = Split(DataLine, dlDel) If UBound(dlFields) -1 >= 2 Then ' at least two fields found propName = dlFields(1) propValue = dlFields(2) Return True Else Return False End If End Function Function CheckMarker(DataLine, mGroup, mItems) Dim cMarkers() As String cMarkers = Split(DataLine, "-") Debug.Print(LBound(cMarkers)) Debug.Print(UBound(cMarkers)) If UBound(cMarkers) >= 1 Then ' at least two fields found mGroup = Right(cMarkers(0), Len(cMarkers(0))-1) mItems = Right(DataLine, Len(DataLine)-Len(mGroup)-2) Debug.Print(mGroup) Debug.Print(mItems) Else Return False End If Return True End Function Function CheckImage(DataLine, cImageFile, iPara1, iPara2, cDir) Dim cArguments() As String Dim i As Integer iPara1 = 0 iPara2 = 0 DataLine = Mid(DataLine, 2, Len(DataLine)-2) cArguments = Split(DataLine, "|") For i = 0 To (UBound(cArguments)) Select Case i Case 0 cImageFile = cArguments(0) Case 1 iPara1 = CInt(cArguments(1)) Case 2 iPara2 = CInt(cArguments(2)) End Select If Len(cImageFile) = 0 Then Return False End If Next cImageFile = cDir + cImageFile Return True End Function Sub ProcessTextLine(DataLine, cTopic, iLevel) Debug.Print("text: " & DataLine) If iLevel = 0 Then Debug.Print("skip this line") End If End Sub Sub Main Debug.Clear Debug.Print("Start") Dim cChar As String ' command line first characters Dim cDir As String 'default document location Dim iLevel As Integer ' current level Dim oTopic As Topic ' current topic Dim cImageFile As String Dim oDocument As String 'active document Dim DataLine As String Dim Filename As String Dim FileNum As Integer Dim hLevel As Integer Dim hText As String Dim hypTitle As String Dim hypURL As String Dim iCommand As Integer ' command type: 1 topic, 2, hyperlink, 3 property, 4 marker, 0 none Dim iPara2 As Integer 'image height in mm, parameter 2 Dim iPara1 As Integer ' image width in mm, parameter 1 Dim mGroup As String Dim mItems As String Dim nl2 As String ' 2 Newlines Dim nLine As Integer ' input line number Dim propName As String ' property name Dim propValue As String ' property value iLevel = 0 ' current level cChar = "#[:!(" ' command chars cDir = GetPath(mmDirectoryMyMaps) 'default document location (eg "G:\Mijn Drive\2021\") nLine = 0 'input line number nl2 = String(2, 10) '2 newline characters FileNum = FreeFile() Filename = GetFilePath("abc", "md", cDir, "Select batch.md file to process") Open Filename For Input As FileNum While Not EOF(FileNum) Or iLevel = -1 Line Input #FileNum, DataLine ' read in data 1 line at a time Debug.Print(DataLine) DataLine = StrConv(DataLine, vbFromUTF8) Debug.Print(DataLine) nLine = nLine + 1 iCommand = InStr(cChar, Mid(DataLine, 1, 1)) If iLevel = 0 And iCommand <> 1 Then iCommand = 0 End If Select Case iCommand Case 1 Debug.Print "topic" If CheckHeading(DataLine, hLevel, hText, iPara1, iPara2) Then Debug.Print("topic: " & DataLine) Call MMaddTopic(iLevel, hLevel, hText, iPara1, iPara2, oTopic) Else iCommand = 0 End If Case 2 Debug.Print "hyperlink" If CheckHyperlink(DataLine, hypTitle, hypURL) Then Debug.Print("hyperlink : "& DataLine) Debug.Print(hypTitle) Debug.Print(hypURL) Call MMaddHyperlink(hypTitle, hypURL, oTopic) Else iCommand = 0 End If Case 3 Debug.Print "property" If CheckProperty(DataLine, propName, propValue) Then Debug.Print("property: "& DataLine) Call MMaddProperty(propName, propValue, oTopic) Else iCommand = 0 End If Case 4 Debug.Print "marker" If CheckMarker(DataLine, mGroup, mItems) Then Debug.Print("marker: " & DataLine) Call MMaddMarker(mGroup, mItems, oTopic) Else iCommand = 0 End If Case 5 Debug.Print "image" If CheckImage(DataLine, cImageFile, iPara1, iPara2, cDir) Then Debug.Print("image: " & DataLine) Call MMaddImage(cImageFile, iPara1, iPara2, oTopic) Else iCommand = 0 End If End Select If iCommand = 0 Then Call ProcessTextLine(DataLine, oTopic, iLevel) End If Wend MsgBox("Batch file name: " & Filename & nl2 & "Number of lines: " & Str(nLine) & nl2 & "End of file reached.", 7, "End of batch file reached") End Sub