我需要一种在microstation图形中自动添加/更新包含文件名的文本的方法。这有助于使用excel中创建的五音表进行文本替换。办公室正在使用v8和xm,没有计划在短期内使用新版本
我查阅了一些代码示例并将其放在一起,它可以扫描dgn中的文本(包含.dgn)用新文件名更新,如果不是';t发现,它扫描附加的参考文件中的文本进行复制和更新
这是第一个vba代码i';我和我放在一起';我很好奇它怎么能缩短或写得更有效。本人';我想继续学习适用于v8/xm的microstation vba,这将是一个有用的示例。感谢所有帮助/建议。提前谢谢你,Juan
- Sub AddFileName()
- Dim ee As ElementEnumerator
- Dim esc As ElementScanCriteria
- Dim oAttach As Attachment
- Dim oTextele As TextElement
- Dim CopiedElement As TextElement
- Dim path As String
- Dim NewStr As String
- Set esc = New ElementScanCriteria
- path = GetDgnFileName(ActiveModelReference)
- esc.ExcludeAllTypes
- esc.IncludeType msdElementTypeText
- esc.IncludeType msdElementTypeTextNode
- Set ee = ActiveModelReference.Scan(esc)
- Do While ee.MoveNext
- If ee.Current.IsTextElement Then
- Set oTextele = ee.Current
- If InStr(1, oTextele.Text, ".dgn", vbTextCompare) Then
- If Not (NewStr = path) Then
- Set CopiedElement = oTextele
- NewStr = CopiedElement.Text
- NewStr = Replace(NewStr, NewStr, path)
- CopiedElement.Text = NewStr
- CopiedElement.Rewrite
- End If
- End If
- End If
- Loop
- For Each oAttach In ActiveModelReference.Attachments
- Set ee = oAttach.Scan(esc)
- Do While ee.MoveNext
- If ee.Current.IsTextElement Then
- Set oTextele = ee.Current
- If InStr(1, oTextele.Text, ".dgn", vbTextCompare) Then
- If Not (NewStr = path) Then
- Set CopiedElement = ActiveModelReference.CopyElement(oTextele)
- NewStr = CopiedElement.Text
- NewStr = Replace(NewStr, NewStr, path)
- CopiedElement.Text = NewStr
- CopiedElement.Rewrite
- End If
- End If
- End If
- Loop
- Next
- End Sub
|