Changing an xref path - the whole path??

[Anonymous]

I've been searching on this for days and I've found many helpful and diverse ways to identify xrefs, detach them, attach them and to identify the file name. What I can't seem to figure out is how to get the preceeding directory structure aka the entire path. Does anyone have a snippet that will show me what I need to do to get the entire path? I've read the issue may be that you have to get the path from the XREF OBJECT, not the BLOCK OBJECT. How would one go about that? Here's what I've been working with so far (I believe it came from Gordon Price): Dim oXref As AcadExternalReference Private Sub CommandButton1_Click() GetXrefPathByBlockName ("fptcprfapm") ' This is an example xref I have attached to my drawing. "X:\TEST\Subfolder\fptcprfapm.dwg" Label1.Caption = oXref.Path ' This just returns "ftpcprfapm.dwg" End Sub Public Function GetXrefPathByBlock(oBlock As AcadBlock) As String 'returns the path of the xref Dim oXref As AcadExternalReference Dim obj As Object If oBlock.IsXRef Then For Each obj In ThisDrawing.ModelSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = oBlock.Name Then GetXrefPathByBlock = oXref.Path End If End If Next obj For Each obj In ThisDrawing.PaperSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = oBlock.Name Then GetXrefPathByBlock = oXref.Path End If End If Next obj Else GetXrefPathByBlock = "" End If End Function Public Function GetXrefPathByBlockName(BlockName As String) As String 'returns the path of the xref Dim obj As Object For Each obj In ThisDrawing.ModelSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = BlockName Then GetXrefPathByBlockName = oXref.Path Else GetXrefPathByBlockName = "" End If End If Next obj For Each obj In ThisDrawing.PaperSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = BlockName Then GetXrefPathByBlockName = oXref.Path Else GetXrefPathByBlockName = "" End If End If Next obj End Function Public Function vbdPowerSet(strName As String) As AcadSelectionSet Dim objSelSet As AcadSelectionSet Dim objSelCol As AcadSelectionSets Set objSelCol = ThisDrawing.SelectionSets For Each objSelSet In objSelCol If objSelSet.Name = strName Then objSelCol.Item(strName).Delete Exit For End If Next Set objSelSet = objSelCol.Add(strName) Set vbdPowerSet = objSelSet End Function

[Anonymous]

Try this... [code] Option Explicit Sub Test() Dim objEnt As AcadEntity Dim objXref As AcadExternalReference For Each objEnt In ThisDrawing.ModelSpace If TypeOf objEnt Is AcadExternalReference Then Set objXref = objEnt MsgBox GetFileParts(objXref.Path, 0) & GetFileParts(objXref.Path, 1) End If Next objEnt End Sub Public Function GetFileParts(ByVal TempPath As String, ReturnType As Integer) Dim DriveLetter As String Dim DirPath As String Dim FName As String Dim Extension As String Dim PathLength As Integer Dim ThisLength As Integer Dim Offset As Integer Dim FileNameFound As Boolean If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 And ReturnType <> 3 Then Err.Raise 1 Exit Function End If DriveLetter = "" DirPath = "" FName = "" Extension = "" If Mid(TempPath, 2, 1) = ":" Then ' Find the drive letter. DriveLetter = Left(TempPath, 2) TempPath = Mid(TempPath, 3) End If PathLength = Len(TempPath) For Offset = PathLength To 1 Step -1 ' Find the next delimiter. Select Case Mid(TempPath, Offset, 1) Case ".": ' This indicates either an extension or a . or a .. ThisLength = Len(TempPath) - Offset If ThisLength >= 1 Then ' Extension Extension = Mid(TempPath, Offset, ThisLength + 1) End If TempPath = Left(TempPath, Offset - 1) Case "\": ' This indicates a path delimiter. ThisLength = Len(TempPath) - Offset If ThisLength >= 1 Then ' Filename FName = Mid(TempPath, Offset + 1, ThisLength) TempPath = Left(TempPath, Offset) FileNameFound = True Exit For End If Case Else End Select Next Offset If FileNameFound = False Then FName = TempPath Else DirPath = TempPath End If If ReturnType = 0 Then GetFileParts = DriveLetter ElseIf ReturnType = 1 Then GetFileParts = DirPath ElseIf ReturnType = 2 Then GetFileParts = FName ElseIf ReturnType = 3 Then GetFileParts = Extension End If End Function [/code] -- I support two teams: The Red Sox and whoever beats the Yankees. "pkirill" wrote in message news:4203ab2e$1_1@newsprd01... I've been searching on this for days and I've found many helpful and diverse ways to identify xrefs, detach them, attach them and to identify the file name. What I can't seem to figure out is how to get the preceeding directory structure aka the entire path. Does anyone have a snippet that will show me what I need to do to get the entire path? I've read the issue may be that you have to get the path from the XREF OBJECT, not the BLOCK OBJECT. How would one go about that? Here's what I've been working with so far (I believe it came from Gordon Price): Dim oXref As AcadExternalReference Private Sub CommandButton1_Click() GetXrefPathByBlockName ("fptcprfapm") ' This is an example xref I have attached to my drawing. "X:\TEST\Subfolder\fptcprfapm.dwg" Label1.Caption = oXref.Path ' This just returns "ftpcprfapm.dwg" End Sub Public Function GetXrefPathByBlock(oBlock As AcadBlock) As String 'returns the path of the xref Dim oXref As AcadExternalReference Dim obj As Object If oBlock.IsXRef Then For Each obj In ThisDrawing.ModelSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = oBlock.Name Then GetXrefPathByBlock = oXref.Path End If End If Next obj For Each obj In ThisDrawing.PaperSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = oBlock.Name Then GetXrefPathByBlock = oXref.Path End If End If Next obj Else GetXrefPathByBlock = "" End If End Function Public Function GetXrefPathByBlockName(BlockName As String) As String 'returns the path of the xref Dim obj As Object For Each obj In ThisDrawing.ModelSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = BlockName Then GetXrefPathByBlockName = oXref.Path Else GetXrefPathByBlockName = "" End If End If Next obj For Each obj In ThisDrawing.PaperSpace If TypeOf obj Is AcadExternalReference Then Set oXref = obj If oXref.Name = BlockName Then GetXrefPathByBlockName = oXref.Path Else GetXrefPathByBlockName = "" End If End If Next obj End Function Public Function vbdPowerSet(strName As String) As AcadSelectionSet Dim objSelSet As AcadSelectionSet Dim objSelCol As AcadSelectionSets Set objSelCol = ThisDrawing.SelectionSets For Each objSelSet In objSelCol If objSelSet.Name = strName Then objSelCol.Item(strName).Delete Exit For End If Next Set objSelSet = objSelCol.Add(strName) Set vbdPowerSet = objSelSet End Function

[Anonymous]

No, that may not work in 2004+ because of how xrefing has changed to use relative pathing so your objXref.Path will still pull a blank string. The reason is because the xref is not "found" - it is locaed in the same directory or a sub directory. The only sure way is to use FileDependencies. Also, I wouldn't use either of you two code samples. Both of you are iterating EVERY item in model space which could be time consuming - learn to use a filtered selection set [where are ou, Bobby? =)] While this approach is much debated, it works the best on large files. You know how big your files are so use your best judgement. Below is sample code. Just create a new project, add a form with a combobox and a label. When the xref in the combo is selected, the fullname will be placed into the label. From there, you can parse the path out. Pause the code as it runs and pay attention to the oFD - filedependency - and its FullFileName and Found properties. -- Mike ___________________________ Mike Tuersley CADalyst's CAD Clinic Rand IMAGINiT Technologies ___________________________ the trick is to realize that there is no spoon... {BEGIN CODE] Option Explicit Private Sub ComboBox1_Change() Dim oFD As AcadFileDependency For Each oFD In ThisDrawing.FileDependencies If oFD.Feature = "Acad:XRef" Then If oFD.FileName = ComboBox1.Text & ".dwg" Then If oFD.FoundPath <> vbNullString Then Label1.Caption = oFD.FoundPath Else If oFD.FullFileName <> vbNullString Then Label1.Caption = oFD.FullFileName Else Label1.Caption = "no path found" End If End If Exit For End If End If Next Set oFD = Nothing End Sub Private Sub UserForm_Initialize() Dim oXRef As AcadExternalReference Dim sXrefs As AcadSelectionSet Set sXrefs = GetXRefs If Not sXrefs Is Nothing Then For Each oXRef In sXrefs ComboBox1.AddItem oXRef.Name Next End If If Not oXRef Is Nothing Then Set oXRef = Nothing If Not sXrefs Is Nothing Then sXrefs.Delete Set sXrefs = Nothing End If End Sub Private Function GetXRefs() As AcadSelectionSet Dim lCntr As Long Dim iCode() As Integer Dim vValue() As Variant Dim oblk As AcadBlock Dim cXRefs As Collection Dim ssXRefs As AcadSelectionSet Set cXRefs = New Collection 'iterate blocks looking for xrefs On Error Resume Next For Each oblk In ThisDrawing.Blocks If oblk.IsXRef = True Then cXRefs.Add (oblk.Name) If Err.Number <> 0 Then Err.Clear End If Next On Error GoTo 0 If cXRefs.Count > 0 Then ReDim iCode(cXRefs.Count + 2) ReDim vValue(cXRefs.Count + 2) 'start the filter iCode(0) = 0: vValue(0) = "INSERT" iCode(1) = -4: vValue(1) = "" 'select them On Error Resume Next Set ssXRefs = ThisDrawing.SelectionSets.Add("ssXrefs") If Err.Number <> 0 Then Err.Clear ThisDrawing.SelectionSets("ssXrefs").Delete Set ssXRefs = ThisDrawing.SelectionSets.Add("ssXrefs") End If On Error GoTo 0 ssXRefs.Select acSelectionSetAll, , , iCode, vValue If ssXRefs.Count > 0 Then Set GetXRefs = ssXRefs Else Set GetXRefs = Nothing End If Else Set GetXRefs = Nothing End If If Not oblk Is Nothing Then Set oblk = Nothing If Not cXRefs Is Nothing Then Set cXRefs = Nothing If Not ssXRefs Is Nothing Then Set ssXRefs = Nothing End Function [END CODE]

[Anonymous]

LOL! I see that I've garnered a reputation Just for the record, I'm not completely anti-selection sets. I'm just opposed to the exclusive use of them when cleaner code serves the same purpose. -- Bobby C. Jones "Mike Tuersley" wrote in message news:dc7v5fzb8jng$.4kk9ns175jc0.dlg@40tude.net... > No, that may not work in 2004+ because of how xrefing has changed to use > relative pathing so your objXref.Path will still pull a blank string. The > reason is because the xref is not "found" - it is locaed in the same > directory or a sub directory. The only sure way is to use FileDependencies. > > Also, I wouldn't use either of you two code samples. Both of you are > iterating EVERY item in model space which could be time consuming - learn > to use a filtered selection set [where are ou, Bobby? =)] While this > approach is much debated, it works the best on large files. You know how > big your files are so use your best judgement. > > Below is sample code. Just create a new project, add a form with a combobox > and a label. When the xref in the combo is selected, the fullname will be > placed into the label. From there, you can parse the path out. > > Pause the code as it runs and pay attention to the oFD - filedependency - > and its FullFileName and Found properties. > > -- Mike > ___________________________ > Mike Tuersley > CADalyst's CAD Clinic > Rand IMAGINiT Technologies > ___________________________ > the trick is to realize that there is no spoon... > > > {BEGIN CODE] > Option Explicit > > Private Sub ComboBox1_Change() > Dim oFD As AcadFileDependency > For Each oFD In ThisDrawing.FileDependencies > If oFD.Feature = "Acad:XRef" Then > If oFD.FileName = ComboBox1.Text & ".dwg" Then > If oFD.FoundPath <> vbNullString Then > Label1.Caption = oFD.FoundPath > Else > If oFD.FullFileName <> vbNullString Then > Label1.Caption = oFD.FullFileName > Else > Label1.Caption = "no path found" > End If > End If > Exit For > End If > End If > Next > Set oFD = Nothing > End Sub > > Private Sub UserForm_Initialize() > Dim oXRef As AcadExternalReference > Dim sXrefs As AcadSelectionSet > Set sXrefs = GetXRefs > If Not sXrefs Is Nothing Then > For Each oXRef In sXrefs > ComboBox1.AddItem oXRef.Name > Next > End If > If Not oXRef Is Nothing Then Set oXRef = Nothing > If Not sXrefs Is Nothing Then > sXrefs.Delete > Set sXrefs = Nothing > End If > End Sub > > Private Function GetXRefs() As AcadSelectionSet > Dim lCntr As Long > Dim iCode() As Integer > Dim vValue() As Variant > Dim oblk As AcadBlock > Dim cXRefs As Collection > Dim ssXRefs As AcadSelectionSet > > Set cXRefs = New Collection > > 'iterate blocks looking for xrefs > On Error Resume Next > For Each oblk In ThisDrawing.Blocks > If oblk.IsXRef = True Then > cXRefs.Add (oblk.Name) > If Err.Number <> 0 Then Err.Clear > End If > Next > On Error GoTo 0 > > If cXRefs.Count > 0 Then > > ReDim iCode(cXRefs.Count + 2) > ReDim vValue(cXRefs.Count + 2) > > 'start the filter > iCode(0) = 0: vValue(0) = "INSERT" > iCode(1) = -4: vValue(1) = " 'iterate our collection and add the block > 'names to the search criteria > For lCntr = 1 To cXRefs.Count > iCode(lCntr + 1) = 2: vValue(lCntr + 1) = cXRefs(lCntr) > Next > 'end the filter > iCode(lCntr + 1) = -4: vValue(lCntr + 1) = "OR>" > 'select them > On Error Resume Next > Set ssXRefs = ThisDrawing.SelectionSets.Add("ssXrefs") > If Err.Number <> 0 Then > Err.Clear > ThisDrawing.SelectionSets("ssXrefs").Delete > Set ssXRefs = ThisDrawing.SelectionSets.Add("ssXrefs") > End If > > On Error GoTo 0 > > ssXRefs.Select acSelectionSetAll, , , iCode, vValue > > If ssXRefs.Count > 0 Then > Set GetXRefs = ssXRefs > Else > Set GetXRefs = Nothing > End If > > Else > Set GetXRefs = Nothing > End If > > If Not oblk Is Nothing Then Set oblk = Nothing > If Not cXRefs Is Nothing Then Set cXRefs = Nothing > If Not ssXRefs Is Nothing Then Set ssXRefs = Nothing > > End Function > [END CODE]

[Anonymous]

BTW - I wouldn't change from the nice clean For Each entity In ... If TypeOf entity Is ... ... End If Next ... to using a selection set unless actual testing showed that this particular section of code didn't meet acceptable performance criteria. I figured that I had better state that or else my reputation might get tarnished! BTW - I was rather dissapointed that I didn't see you this year at AU Mike :-( -- Bobby C. Jones

[Anonymous]

Yeah, not half as much as I was! We're still too short staffed and projects take priority - or so I'm told 😉 I'll be there this year and the first round is on me! -- Mike ___________________________ Mike Tuersley CADalyst's CAD Clinic Rand IMAGINiT Technologies ___________________________ the trick is to realize that there is no spoon...

[Anonymous]

Thanks Matt! That got me back on track! "Matt W" wrote in message news:4203b462$1_1@newsprd01... > Try this... > > [code] > Option Explicit > > Sub Test() > Dim objEnt As AcadEntity > Dim objXref As AcadExternalReference > For Each objEnt In ThisDrawing.ModelSpace > If TypeOf objEnt Is AcadExternalReference Then > Set objXref = objEnt > MsgBox GetFileParts(objXref.Path, 0) & > GetFileParts(objXref.Path, 1) > End If > Next objEnt > End Sub > > Public Function GetFileParts(ByVal TempPath As String, ReturnType As > Integer) > Dim DriveLetter As String > Dim DirPath As String > Dim FName As String > Dim Extension As String > Dim PathLength As Integer > Dim ThisLength As Integer > Dim Offset As Integer > Dim FileNameFound As Boolean > > If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 And > ReturnType <> 3 Then > Err.Raise 1 > Exit Function > End If > > DriveLetter = "" > DirPath = "" > FName = "" > Extension = "" > > If Mid(TempPath, 2, 1) = ":" Then ' Find the drive letter. > DriveLetter = Left(TempPath, 2) > TempPath = Mid(TempPath, 3) > End If > > PathLength = Len(TempPath) > > For Offset = PathLength To 1 Step -1 ' Find the next delimiter. > Select Case Mid(TempPath, Offset, 1) > Case ".": ' This indicates either an extension or a . or a .. > ThisLength = Len(TempPath) - Offset > If ThisLength >= 1 Then ' Extension > Extension = Mid(TempPath, Offset, ThisLength + 1) > End If > TempPath = Left(TempPath, Offset - 1) > Case "\": ' This indicates a path delimiter. > ThisLength = Len(TempPath) - Offset > If ThisLength >= 1 Then ' Filename > FName = Mid(TempPath, Offset + 1, ThisLength) > TempPath = Left(TempPath, Offset) > FileNameFound = True > Exit For > End If > Case Else > End Select > > Next Offset > > If FileNameFound = False Then > FName = TempPath > Else > DirPath = TempPath > End If > > If ReturnType = 0 Then > GetFileParts = DriveLetter > ElseIf ReturnType = 1 Then > GetFileParts = DirPath > ElseIf ReturnType = 2 Then > GetFileParts = FName > ElseIf ReturnType = 3 Then > GetFileParts = Extension > End If > End Function > [/code] > > -- > I support two teams: The Red Sox and whoever beats the Yankees. > > "pkirill" wrote in message > news:4203ab2e$1_1@newsprd01... > I've been searching on this for days and I've found many helpful and > diverse ways to identify xrefs, detach them, attach them and to identify > the file name. > > What I can't seem to figure out is how to get the preceeding directory > structure aka the entire path. Does anyone have a snippet that will show > me what I need to do to get the entire path? I've read the issue may be > that you have to get the path from the XREF OBJECT, not the BLOCK OBJECT. > How would one go about that? > > Here's what I've been working with so far (I believe it came from Gordon > Price): > > Dim oXref As AcadExternalReference > > Private Sub CommandButton1_Click() > GetXrefPathByBlockName ("fptcprfapm") ' This is an example xref I have > attached to my drawing. "X:\TEST\Subfolder\fptcprfapm.dwg" > Label1.Caption = oXref.Path ' This just returns > "ftpcprfapm.dwg" > End Sub > > Public Function GetXrefPathByBlock(oBlock As AcadBlock) As String > 'returns the path of the xref > Dim oXref As AcadExternalReference > Dim obj As Object > If oBlock.IsXRef Then > For Each obj In ThisDrawing.ModelSpace > If TypeOf obj Is AcadExternalReference Then > Set oXref = obj > If oXref.Name = oBlock.Name Then > GetXrefPathByBlock = oXref.Path > End If > End If > Next obj > For Each obj In ThisDrawing.PaperSpace > If TypeOf obj Is AcadExternalReference Then > Set oXref = obj > If oXref.Name = oBlock.Name Then > GetXrefPathByBlock = oXref.Path > End If > End If > Next obj > Else > GetXrefPathByBlock = "" > End If > > End Function > > Public Function GetXrefPathByBlockName(BlockName As String) As String > 'returns the path of the xref > > Dim obj As Object > For Each obj In ThisDrawing.ModelSpace > If TypeOf obj Is AcadExternalReference Then > Set oXref = obj > If oXref.Name = BlockName Then > GetXrefPathByBlockName = oXref.Path > Else > GetXrefPathByBlockName = "" > End If > End If > Next obj > For Each obj In ThisDrawing.PaperSpace > If TypeOf obj Is AcadExternalReference Then > Set oXref = obj > If oXref.Name = BlockName Then > GetXrefPathByBlockName = oXref.Path > Else > GetXrefPathByBlockName = "" > End If > End If > Next obj > > End Function > > Public Function vbdPowerSet(strName As String) As AcadSelectionSet > Dim objSelSet As AcadSelectionSet > Dim objSelCol As AcadSelectionSets > Set objSelCol = ThisDrawing.SelectionSets > For Each objSelSet In objSelCol > If objSelSet.Name = strName Then > objSelCol.Item(strName).Delete > Exit For > End If > Next > Set objSelSet = objSelCol.Add(strName) > Set vbdPowerSet = objSelSet > End Function > > > >