Type txtBorder
gg As Long
lineWeight As Integer
color As Long
level As String
prio As Long 'V8i
End Type
Public tBorder As txtBorder
' ===============================================================================
Sub textBorder()
Dim sScanEnumerator As ElementEnumerator
Dim sElement As element
Dim gg As Long
Dim sFence As Fence
tBorder.lineWeight = 4
tBorder.color = 16
tBorder.level = "Border"
Set sFence = ActiveDesignFile.Fence
If ActiveModelReference.AnyElementsSelected Or sFence.IsDefined Then
If ActiveModelReference.AnyElementsSelected Then
Set sScanEnumerator = ActiveModelReference.GetSelectedElements
Else
Set sScanEnumerator = sFence.GetContents
End If
ActiveModelReference.UnselectAllElements
Do While sScanEnumerator.MoveNext
Set sElement = sScanEnumerator.Current
If sElement.Type = msdElementTypeText Or sElement.Type = msdElementTypeTextNode Then
besuTextBorder sElement, tBorder
tBorder.prio = sElement.DisplayPriority 'v8i
End If
Loop
Else
CommandState.StartLocate New classTextBorder
End If
End Sub
Function besuTextBorder(sElement As element, tBorder As txtBorder)
gg = UpdateGraphicGroupNumber 'CurrentGraphicGroup
tBorder.gg = gg
If sElement.Type = msdElementTypeTextNode Then
dropElemTN sElement, tBorder
End If
If sElement.Type = msdElementTypeText Then
dropElemT sElement, tBorder
End If
sElement.GraphicGroup = tBorder.gg
sElement.Rewrite
End Function
' ===============================================================================
Function dropElemTN(oEle As element, tBorder As txtBorder)
ShowStatus ""
On Error GoTo NoElement
If oEle.IsDroppableElement Then
Dim oDE As DroppableElement
Dim oEE As ElementEnumerator
Set oDE = oEle
Set oEE = oDE.Drop
Do While oEE.MoveNext
If oEE.Current.Type = msdElementTypeText Then
dropElemT oEE.Current, tBorder.gg
End If
Loop
End If
Exit Function
NoElement:
ShowStatus "Element not found"
End Function
' ===============================================================================
Function dropElemT(oEle As element, tBorder As txtBorder)
ShowStatus ""
On Error GoTo NoElement
If oEle.IsDroppableElement Then
Dim oNew As element
Dim oDE As DroppableElement
Dim oEE As ElementEnumerator
Set oDE = oEle
Set oEE = oDE.Drop
Do While oEE.MoveNext
Set oNew = oEE.Current
ActiveModelReference.AddElement oNew
oNew.lineWeight = tBorder.lineWeight
oNew.color = tBorder.color
oNew.DisplayPriority = tBorder.prio - 1 'v8i
oNew.GraphicGroup = tBorder.gg
oNew.level = besuLevel(tBorder.level & "_" & oEle.level.Name)
oNew.Rewrite
If oNew.IsClosedElement Then
oNew.AsClosedElement.FillMode = msdFillModeNotFilled
oNew.Rewrite
End If
If oNew.IsCellElement Then
CellElem oNew.AsCellElement
End If
Loop
End If
Exit Function
NoElement:
ShowStatus "Element not found"
End Function
' ===============================================================================
Function CellElem(cEle As CellElement)
Dim cComponents As ElementEnumerator
On Error GoTo NoElement
Set cComponents = cEle.GetSubElements
Do While cComponents.MoveNext
Dim cComponent As element
Set cComponent = cComponents.Current
If cComponent.IsClosedElement Then
cComponent.AsClosedElement.FillMode = msdFillModeNotFilled
cComponent.Rewrite
End If
Loop
'cEle.Rewrite
Exit Function
NoElement:
ShowStatus "Element not found"
End Function
' ===============================================================================
Function besuLevel(levname As String) As level
Set besuLevel = ActiveDesignFile.Levels.Find(levname)
If besuLevel Is Nothing Then
CadInputQueue.SendKeyin "level create " & Chr(34) & levname & Chr(34)
'Set besuLevel = ActiveDesignFile.Levels.Find(levname)
End If
Set besuLevel = ActiveDesignFile.Levels.Find(levname)
End Function
class module
classTextBorder
Option Explicit
Implements ILocateCommandEvents
' ===============================================================================
' DATAPOINT HANDLER
' ===============================================================================
Private Sub ILocateCommandEvents_Accept(ByVal element As element, point As Point3d, ByVal View As View)
besuTextBorder element, tBorder
' CommandState.StartPrimitive New classDrawValve
End Sub
' ===============================================================================
' CLEANUP HANDLER
' ===============================================================================
Private Sub ILocateCommandEvents_Cleanup()
End Sub
' ===============================================================================
' DYNAMICS HANDLER
' ===============================================================================
Private Sub ILocateCommandEvents_Dynamics(point As Point3d, _
ByVal View As View, ByVal DrawMode As MsdDrawingMode)
End Sub
' ===============================================================================
' LOCATE FAILED HANDLER
' ===============================================================================
Private Sub ILocateCommandEvents_LocateFailed()
CommandState.StartLocate New classTextBorder
End Sub
' ===============================================================================
' LOCATE FILTER
' ===============================================================================
Private Sub ILocateCommandEvents_LocateFilter(ByVal element As element, _
point As Point3d, Accepted As Boolean)
Accepted = False
If (element.IsTextElement) Or (element.IsTextNodeElement) Then
Accepted = True
End If
End Sub
' ===============================================================================
' RESET HANDLER
' ===============================================================================
Private Sub ILocateCommandEvents_LocateReset()
CommandState.StartLocate New classTextBorder
' CommandState.StartDefaultCommand
End Sub
' ===============================================================================
' LOCATE INITIALIZATION
' ===============================================================================
Private Sub ILocateCommandEvents_Start()
Dim lc As LocateCriteria
Set lc = CommandState.CreateLocateCriteria(False)
CommandState.SetLocateCriteria lc
CommandState.EnableAccuSnap
ShowCommand "Place Component"
ShowPrompt "Select Text or TextNode"
End Sub
Video