添加/更新文本文件名(Microstation)
我需要一种在microstation图形中自动添加/更新包含文件名的文本的方法。这有助于使用excel中创建的五音表进行文本替换。办公室正在使用v8和xm,没有计划在短期内使用新版本我查阅了一些代码示例并将其放在一起,它可以扫描dgn中的文本(包含.dgn)用新文件名更新,如果不是';t发现,它扫描附加的参考文件中的文本进行复制和更新
这是第一个vba代码i';我和我放在一起';我很好奇它怎么能缩短或写得更有效。本人';我想继续学习适用于v8/xm的microstation vba,这将是一个有用的示例。感谢所有帮助/建议。提前谢谢你,JuanSub 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
在不评论代码的情况下,有什么理由不使用笔表的文本替换功能吗?我刚刚参与了一个本地点项目,在它们的表单边框中有一些不同的文本字符串,如$username$和$dgnname$,它们的绘图驱动程序会自动调用它们的五角大楼,它会自动用完整路径文件名和我的Windows用户名替换它们
我不知道文本字符串必须完全匹配。换句话说,您不能将其作为字符串:
文件:$dgname$
,除非文件:部分是一段文本,$dgnname$是一段单独的文本。 感谢您的回复
让我再解释一下这种情况:
我们已经在文本替换中使用了pentable(包括放置在边框顶部的$dgn$)。但为了更新页码,我们替换了实际的文件名。文本必须包含文件名,因为它不能替换另一个文本替换字符串
例如:假设文件名为drawing1.dgn  &引用$dgn$”;打印为“;图纸1.dgn“;带五音  &引用;图纸1.dgn“;打印为“;1“;带五角大楼 
这段代码的作用是搜索包含“的字符串”;。dgn“;使用当前文件名更新或复制/更新以与笔表一起使用。您可以想象,如果将其用于包含数百个图形的项目,会有多大帮助
对于该站点的少数microstation用户…
请点击这里#039;这是我从';MicroStation V8 2004版-VBA和#039;社区论坛。bentley.com
页:
[1]