使用VBA在AutoCAD 2014中阻止参考超链接属性?

时间:2016-04-19 18:18:42

标签: vba hyperlink autocad

我有这个.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

2 个答案:

答案 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>