"Mel Arquiza" <carquiza@[EMAIL PROTECTED]
> wrote in message
news:240f743821922a9eda6f0a10d269aa48.75998@[EMAIL PROTECTED]
> I am using Microstation Basic.
> How can you able to extract all the text attributes on a given dgn file?
> Thanks.
Nobody answer this question. I will answer it.
Here is just a basic code: Any comment great appreciated.
'Microstation Basic
'The purposed of this macro is to extract text to DGN files and create a
txt file name "textout.txt"
'Created and program by Mel Arquiza
Sub main
Dim elemSet as New MbeElementSet
Dim elem as New MbeElement
Dim setMember as MbeSetMember
Dim origin as MbePoint
Dim elemText as String
Dim fontnam as String
Dim justi as Integer
Dim CharW as Double
Dim CharH as Double
Dim filePos as Long
Dim fileNum as Integer
Dim saveMsgs as Integer
Dim stat as long
Dim rMatrix(0 to 2, 0 to 2) as Double
A = FreeFile
'Turn off messages
saveMsgs = MbeState.messages
MbeState.messages = 0
'Creates an output file
Open "C:\textout.txt" for output access write as #A
'Get element set from either selection set or fence
If elemSet.fromSelectionSet (1) <> MBE_Success Then
If elemSet.fromFence () <> MBE_Success Then
MbeWriteStatus "No fence or selection set"
Else
MbeWriteStatus "Processing Fence"
End If
Else
MbeWriteStatus "Processing Selection Set"
End If
'Get first member
status = elemSet.getFirst (setMember)
'Do While Loop
Do While status = MBE_Success
filePos = elem.fromFile (setMember.filePos, setMember.fileNum)
If elem.type = MBE_Text Then
If elem.getOrigin (origin) = MBE_Success Then
If elem.getString (elemText) = MBE_Success Then
If elem.getRotation(rMatrix) = MBE_Success Then
'Get Angle Rotation
txt1$ = Format$(Str$(rMatrix(0,0)),"0.000")
txt2$ = Format$(Str$(rMatrix(0,1)),"0.000")
txt3$ = Format$(Str$(rMatrix(1,0)),"0.000")
'Get Font Name
fontnam = elem.fontname
'Get Justification
justi = elem.justification
'Get Character Width
charW = elem.charWidth
'Get Character Height
charH = elem.charHeight
'Write to text file
write #A,
txt1$,txt2$,txt3$,Format$(origin.x,"#######.####"),Format$(origin.y,"#######.####"),fontnam,justi,charW,charH,elemtext
End If
End If
End If
End If
status = elemSet.getNext (setMember)
Loop
'close all open files
Close #A
'clear selection set
elemSet.clear
'restore messages
MbeState.messages = saveMsgs
End Sub
--
Posted via Mailgate.ORG Server - http://www.Mailgate.ORG
|
