CADForums.net

baljinder · Guest

MSTN wisers,
does anybody have an already defined MDL code/utility to convert
microstation type 17 elements into a type 7 text node ? I would need
to have the source code since I would then need to differentiate which
text elements to modify and which not since I would not want my
symbols to be converted!

Thanks in advance,
-- Balla.

Bevan · Guest

Watch for word wrap.

<begin txt2node.bas>
' This program converts all selected text elements or text nodes into a
single text node.
'---------------------------------------------------------------------------
-------------
'
' © Copyright (1999) Andrei Columban, All rights reserved
'
' File Name: Txt2Node.bas
' Version: 1.0
' Date: 29.10.1999
'
' Redistribution and use in source and binary forms, with or without
' modification, are permitted provided that the following conditions
' are met:
'
' Redistribution of source code must retain the above copyright
' notice, this list of conditions and the following disclaimer.
'
' Redistribution in binary form must reproduce the above copyright
' notice, this list of conditions and the following disclaimer in
' the documentation and/or other materials provided with the
' distribution.
'
' Neither names of Andrei Columban, Ramsey Systems, Inc. nor the names
' of its contributors may be used to endorse or promote products derived
' from this software without specific prior written permission.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
' "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT
' NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS
' OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
' SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
' LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
' USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
' AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
' OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
' OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
' OF SUCH DAMAGE.
'
' - Andrei Columban - Oct 1999 - andrei@transdata.ro
'--------------------------------------------------------------------------

Const FENCEBUTTON = 1000
Const SELSETBUTTON = 1001
Const CANCELBUTTON = 1003
Const LF = Chr$(10)

Dim firstRow As Integer
Dim elemSet As MbeElementSet
Dim TxtSum As String
Dim IsText As Integer

'----------------------
' Process text element
'----------------------
Sub ProcessText(elem As MbeElement)
Dim TextStr As String

stat = elem.getstring(TextStr)
If firstRow = 0 Then
TxtSum = TextStr
MbeSendAppMessage "TEXTEDIT", "FirstLine " + TextStr
firstRow = 1
Else
MbeSendAppMessage "TEXTEDIT", "NextLine " + TextStr
End If
End Sub

'-------------------------------
' Checks if element is MBE_Text
'-------------------------------
Sub TextCheck(elem As MbeElement)
MbeWritePrompt "Checking for text..."
stat = elem.Type
If elem.Type = MBE_Text Then
ProcessText elem
End If
End Sub

'-------------------------------------
' Process elements from selection set
'-------------------------------------
Sub processSet()
Dim elem As New MbeElement
Dim filePos As Long
Dim setMember As MbeSetMember
Dim status As Long
Dim origin As MbePoint
Dim view As Integer

' Open up the text editor
MbeSendCommand "PLACE DIALOGTEXT ICON "

status = elemSet.getFirst(setMember)

While status = MBE_Success
filePos = elem.FromFile(setMember.filePos, setMember.FileNum)
status = elem.FromFile(filePos)
Call processElement(0, elem)
status = elemSet.getNext(setMember)
Wend

If IsText = 0 Then Goto NOTEXT

'Place text node in drawing
MbeWriteCommand "Place text node in the drawing !"
MbeWritePrompt "(RESET to exit)"
MbeGetInput MBE_DataPointInput, MBE_ResetInput, MBE_CommandInput
If MbeState.inputType = MBE_DataPointInput Then
status = MbeState.getInputDataPoint(origin, view)
MbeSendDataPoint origin, view
ElseIf MbeState.inputType = MBE_ResetInput Then
MbeStartDefaultCommand
End If

NOTEXT:
End Sub

'------------------------------------------------------------
' ProcessElement extracts components out of complex elements
'------------------------------------------------------------
Sub processElement(nestlevel As Integer, elem As MbeElement)
Dim gotNext As Integer

Do
stat = elem.Type
If elem.Type <> MBE_Text AND elem.Type <> MBE_TextNode Then
Goto NEXTELEMENT
Else
IsText = 1
TextCheck elem
End If
If elem.isheader <> 0 Then
If elem.nextComponent = Mbe_Success Then
Call processElement(nestlevel + 1, elem)
End If
gotNext = elem.nextelement
Else
NEXTELEMENT:
gotNext = elem.nextComponent
End If
Loop While gotNext = Mbe_Success
End Sub

'-----------------
' Main Subroutine
'-----------------
Sub Main()
Dim fence As Integer
Dim filePos As Long
Dim stat As Long

MbeSendCommand "MARK "
MbeSendCommand "NOECHO "
MbeWriteMessage "Txt2Node - © Andrei Columban, 1999"

Set elemSet = New MbeElementSet
If elemSet.fromSelectionSet() = MBE_Success Then
selset = True
End If

'We use the tcb variable here because elemSet.fromFence clears the
active selection set
If MbeCExpressionDouble("tcb->fence") Then
fence = True
End If

If fence And selset Then 'Both Selection Set and Fence active!
MbeWriteMessage "Which selection type?"

button = MbeOpenModalDialog(1)

Select Case button
Case FENCEBUTTON
selset = False
status = elemSet.fromFence()
If status = 0 Then
processSet
End If
Case SELSETBUTTON
fence = False
'Eliminate fence
MbeSendCommand "PLACE FENCE ICON "
MbeSendCommand "CHOOSE ELEMENT "
status = elemSet.fromSelectionSet()
If status = 0 Then
processSet
End If
Case CANCELBUTTON
GoTo EXITMAIN
Case Else
End Select
ElseIf fence Then 'Fence only active
status = elemSet.fromFence()
If status = 0 Then
processSet
End If
ElseIf selset Then 'Selection set only active
status = elemSet.fromSelectionSet()
If status = 0 Then
processSet
End If
End If

If selset = False And fence = False Then
MbeWriteMessage "No fence or selection set!"
ElseIf IsText = 0 Then
MbeWriteMessage "Selection does not contains text elements!"
MbeStartDefaultCommand
End If

EXITMAIN:
MbeSendCommand "UPDATE BOTH "
MbeWritePrompt
MbeSendCommand "ECHO "

End Sub

<end of bas>

"baljinder" <bsingh@hotmail.com> wrote in message
news:e637c1ee.0403080644.6c1dcf09@posting.google.com...

	CADForums.net Forum Index -> MicroStation	All times are GMT
Page 1 of 1