我有这个.dwg文件,有数百个块引用。 我试图从所有块引用创建到pdf文件的超链接。 pdf在我的D盘上。
例如,块引用的名称为:'2:test', '26:test', '234:test'
。基本上是超链接
每个点都是:'2:test' would hyperlink to D:\Reports\File-002.pdf
;
'26:test' would hyperlink to D:\Reports\File-026.pdf
; '234:test' would hyperlink to D:\Reports\File-234.pdf
。
从块开始 引用我得到':'之前的数字,其匹配的pdf将是'文件 - '接着是'之前的数字:' 3位数。 手中有很多这样做,我想我可以为此编程。
我有足够的基本编程知识来操作字符串来获取我的数字并将其转换为3位数。我的问题 和/或需要帮助的是如何遍历文件上的每个块引用(for循环)并能够写入其超链接属性?这甚至可能吗?
在来到这里之前,我有点看了这些链接,但它们没有证明有用: Link1; Link2; Link3
感谢提示
更新
Private Sub CommandButton1_Click()
Dim ReadData As String
Open "C:\Desktop\Files\DesignFile.DWG" For Input As #1
Do Until EOF(1)
Line Input #1, ReadData
MsgBox ReadData 'Adding Line to read the whole line, not only first 128 positions
Loop
Close #1
End Sub
答案 0 :(得分:0)
你可以试试这个:
Dim stringInput
stringInput = "2:test', '26:test', '234:test"
stringSplit = Split(stringInput, ",")
For i = 0 To UBound(stringSplit)
Debug.Print (stringSplit(i))
Next i
输出:
2:测试
'26:测试
“234:测试
答案 1 :(得分:0)
你可以试试这个
Option Explicit
Sub test()
Dim acBlockRef As AcadBlockReference
Dim baseStrng As String
baseStrng = "D:\Reports\File-"
For Each acBlockRef In BlockRefsSSet("BlockRefs")
acBlockRef.Hyperlinks.Add("PDF").URL = baseStrng & Format(Left(acBlockRef.Name, InStr(acBlockRef.Name, "-") - 1), "000") & ".pdf"
Next acBlockRef
ThisDrawing.SelectionSets("BlockRefs").Delete
End Sub
'-----------------------------------------------------------------
'helper functions
'------------------
Function BlockRefsSSet(ssetName As String, Optional acDoc As Variant) As AcadSelectionSet
'returns a selection set of all block references in the passed drawing
Dim acSelSet As AcadSelectionSet
Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant
Set BlockRefsSSet = CreateSelectionSet(ssetName, acDoc)
Filtertype(0) = 0: Filterdata(0) = "INSERT"
BlockRefsSSet.Select acSelectionSetAll, , , Filtertype, Filterdata
End Function
Function CreateSelectionSet(selsetName As String, Optional acDoc As Variant) As AcadSelectionSet
'returns a selection set with the given name
'if a selectionset with the given name already exists, it'll be cleared
'if a selectionset with the given name doesn't exist, it'll be created
Dim acSelSet As AcadSelectionSet
If IsMissing(acDoc) Then Set acDoc = ThisDrawing
On Error Resume Next
Set acSelSet = acDoc.SelectionSets.Item(selsetName) 'try to get an exisisting selection set
On Error GoTo 0
If acSelSet Is Nothing Then Set acSelSet = acDoc.SelectionSets.Add(selsetName) 'if unsuccsessful, then create it
acSelSet.Clear 'cleare the selection set
Set CreateSelectionSet = acSelSet
End Function
'-----------------------------------------------------------------
以下注意事项:
块名称中不能有冒号(“:”)
所以我用了一个hypen(“ - ”)代替
每个块引用对象都将附加与块名称相关联的URL(“D:\ Reports \ File- nnn .pdf”),它是
<的引用/ LI>