hexagon logo

Ballooning script / Problem with "SetLine"

Hi everyone,

I wanted to write a script, that loops through all comments in PCDMIS and changes them accordingly...

We use Ballooned drawings and sometimes have 5 times the same dimension so we'd name them (for example dimension number 80) (80.1) / (80.2) / (80.3) ...
The script should correct multiple occurences automatically. So I would just have to put (80) each time in my comment and the script will keep track of every occurence and change them...

Allmost everything works fine; Unluckily i still have problems with the "SetLine" Command... Says "missing Argument(s)" but in the documentation i dont see any clue on what's going wrong.

Sub Main()
Dim PCDApp As Object
Dim PCDPartPrograms As Object
Dim PCDPartProgram As Object
Dim PCDCommands As Object
Dim PCDCommand As Object
Dim PCDComment As Object

Dim sContents As String
Dim iCnt As Integer
Dim j As Integer
Dim iCount As Integer
Dim num as Integer
Dim arr() as Integer


Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands

For iCnt = 1 To PCDCommands.Count
Set PCDCommand = PCDCommands.Item(iCnt)
If (PCDCommand.IsComment) Then
Set PCDComment = PCDCommand.CommentCommand
If (PCDComment.CommentType = 1) And (inStr(1,PCDComment.Comment,"Aln")<1)Then
For j = 1 To 10
If (PCDComment.GetLine(j)="") Then Exit For
sContents = PCDComment.GetLine(j)
MsgBox sContents 'Bulle mit Klammern
sContents = Replace(sContents, "(", "")
sContents = Replace(sContents, ")", "")
MsgBox sContents 'Bulle ohne Klammern
If IsNumeric(sContents) Then
num = sContents
ReDim Preserve arr(num)
arr(num) = arr(num) + 1
sContents = "(" & num & "." & arr(num) & ")"
MsgBox sContents 'Angepasste Bulle mit Klammern
PCDComment.SetLine(j,sContents) 'funktioniert nicht...
End If
Next
End If
End If
Next iCnt
End Sub


Any Ideas?
Parents Reply Children
No Data