超链接（VBA）问题...
嗨，有超链接问题....我目前正在做的程序将获取用户文本等，并在模型空间中插入一个预先制作的模型空间标记块，以指示所选布局指向的位置 - 它还应该添加指向所选布局的超链接（到标记块），以便用户可以跳转到该布局。
一切都很好，只是超链接部分，我现在必须工作。检查超链接编辑器后，每当您手动将超链接添加到布局时，要显示的路径，url和文本看起来都像它们应该的那样 - 即使在此绘图页面的目标或视图上，它也会突出显示正确的布局，但它不会跳转到布局，而是打开一个Windows资源管理器窗口到绘图路径目录。
如果我打开超链接编辑器，正如我所说，它看起来都很好，并且由于某种原因，如果我单击“确定”，那么这次再次尝试链接是有效的，但前提是我这样做，否则它只会打开资源管理器。
以下是程序代码的摘录。有人可以看看可能出了什么问题，或者让我知道为什么链接不能100%工作。
Option Explicit
Dim response As Integer'Yes/No..
Dim layoutX, layoutY As AcadLayout'Acad Layout..
Dim layoutZ As String
Dim blockX As AcadBlockReference 'Inserted block..
Dim blockPoint As Variant ' Pick point for block insert..
Dim attribZ As Variant ' Attributes for inserted block..
Dim countx As Integer 'Counter for getting attributes..
Dim EntX As AcadEntity 'Acad Object (Block search for dblclick listbox)..
Dim Hyp As AcadHyperlink 'Add hyperlink to block..
Dim HypS As AcadHyperlinks 'Hyperlinks collection for block..
'********************************************
'************** INSERT BLOCK ****************
'********************************************
Private Sub insertmarkerBTN_Click()
' Check if all information is present..
If DetDesc1TXT.Text = "" Then
MsgBox "Please enter the main Detail title..", vbExclamation, "ModelSpace Detail Marker.."
Exit Sub
End If
' Check if all information is present..
If drawnumTXT.Text = "" Then
MsgBox "Please enter the main Drawing Number (or select it from the list)..", vbExclamation, "ModelSpace Detail Marker.."
Exit Sub
End If
ModelDetailRefFRM.Hide
ThisDrawing.ActiveSpace = acModelSpace
'Get pick point..
'Error Test for GetPoint method..
On Error Resume Next
TryAgainX:
blockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the insertion point for the Detail Reference Marker.. ")
ErrHndlrX:
If Err.Number0 Then
Err.Clear
GoTo TryAgainX
End If
On Error GoTo ErrHndlrX
'Insert block..
Set blockX = ThisDrawing.ModelSpace.InsertBlock(blockPoint, "X:\AbiCAD Blocks\General\Detail Reference - MSpace.dwg", 1#, 1#, 1#, 0)
blockX.Layer = "X-Notes"
' Get and edit attributes..
attribZ = blockX.GetAttributes ' Get Block attributes..
' Loop through attributes..
For countx = LBound(attribZ) To UBound(attribZ)
Select Case attribZ(countx).TagString
Case "DRAWING_NUMBER"
attribZ(countx).TextString = drawnumTXT.Text
Case "DETAIL_NUMBER"
attribZ(countx).TextString = detnumTXT.Text
Case "DETAIL_DESC_1"
attribZ(countx).TextString = DetDesc1TXT.Text
Case "DETAIL_DESC_2"
attribZ(countx).TextString = DetDesc2TXT.Text
End Select
Next countx
' Add the Hyperlink to the block to link back to the Layout..
Set HypS = blockX.Hyperlinks
' Add a new Hyperlink complete with all properties
Set Hyp = HypS.Add(LayoutLIST.Text)
Hyp.URL = "#," & layoutZ
Hyp.URLNamedLocation = "," & layoutZ
blockX.Update
ModelDetailRefFRM.Show
End Sub
'********************************************
'************** INSERT BLOCK ****************
'********************************************
有什么想法吗？
干杯，
保罗
基地点设计zltd..
P4 3.0Ghz / 2GB 内存.
XP Pro SP2..
蓝宝石 X1950 512MB 双 DVi 显卡.
AutoCAD 2008..
**** Hidden Message ***** 我没有弄乱超链接，但看起来你可以用xdata做你想做的事情。
然后使用doubleclick事件
1）检查块ref
2）检查xdata
如果是这样做布局thang。 嗨，
太好了，谢谢。这至少清除了一些事情 - 当我回到工作时会测试它。
不过，小问题是什么？布局如何编号？它们是按照您创建的顺序顺序编号的，还是按屏幕底部的 Tab 格式从左到右的顺序编号？我如何正确编码它以找出布局纸质空间视图参考编号？
再次感谢，这为这个主题提供了更多的启示。
这是我使用的代码
Private Sub insertmarkerBTN_Click()
Dim blockX As AcadBlockReference 'Inserted block..
Dim blockPoint As Variant ' Pick point for block insert..
Dim HypS As AcadHyperlinks 'Hyperlinks collection for block..
Dim Hyp As AcadHyperlink
ThisDrawing.ActiveSpace = acModelSpace
blockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the insertion point for the Detail Reference Marker.. ")
Set blockX = ThisDrawing.ModelSpace.InsertBlock(blockPoint, "ScaledFrame", 1#, 1#, 1#, 0)
Set HypS = blockX.Hyperlinks
Set Hyp = HypS.Add(ThisDrawing.Name)
Hyp.URLNamedLocation = "2"
Dim V As AcadView
Dim L As AcadLayout
Dim i As Integer
For Each L In ThisDrawing.Layouts
If Not UCase(L.Name) = "MODEL" Then
i = i + 1
ThisDrawing.ActiveLayout = L
Set V = ThisDrawing.Views.Add(i)
V.LayoutId = L.ObjectID
End If
Next
End Sub
并且图中的超链接将您踢到layout2
Added-看来您必须运行一次代码才能让超链接获得正确的thisdrawing.name 跳转到布局2的原因Since the view for "layout2" is called "2" the following code took me directly to the layout2
它对我有效，并且有足够的信息让你推断出代码对你有效。
我认为这种方法不会给你100%的回报，这有点冒险。
xdata方法和右键单击或双击事件可能更好。
页:
[1]