DAMO Posted July 14, 2010 Share Posted July 14, 2010 Hi, In the past I have changed an existing VBA code so it fits my needs. But now my needs are changed. It was witten to open a block from de Blocks folder in the drawingfolder. But now I want it to be opened from the Blocks folder in a parent folder. There a way to find a certain string in the ThisDrawing.Path and change it to Blocks, but I can't figure it out. My folder stucture is something like this: E:\Documents\10.001 Project\CAD\subdir\ E:\Documents\10.001 Project\CAD\subdir\subdir\drawing.dwg It needs to be something like: E:\Documents\10.001 Project\CAD\blocks\blockdrawing.dwg Can anybody give me some advise? DAMO Sub Start() Dim DwgName, BlkMapName, BlkName As String Dim DwgMapName, MapNameNew As String Dim objEnt As AcadObject Dim varPnt As Variant BlkMapName = ThisDrawing.Path + "\blocks\" ThisDrawing.Utility.GetEntity objEnt, varPnt, "select block" If objEnt.ObjectName = "AcDbBlockReference" Then BlkName = objEnt.Name Else MsgBox "selected item is not a block": Call Start End If ' Looks for the block in de map Blocks in current workmap DwgName = BlkMapName + BlkName + ".dwg" If Dir(DwgName) <> "" Then ThisDrawing.Application.Documents.Open DwgName Else MsgBox ("Block bestaat niet in map. ") End If End Sub Quote Link to comment Share on other sites More sharing options...
DAMO Posted July 16, 2010 Author Share Posted July 16, 2010 Solved it myself! This is the new code: Sub Start() Dim DwgName, BlkMapName, BlkName, ProjMapName As String Dim DwgMapName, MapNameNew, MapNameNew2 As String Dim objEnt As AcadObject Dim varPnt As Variant Dim varTel As Variant DwgMapName = UCase(ThisDrawing.Path) MapNameNew = Replace(DwgMapName, "\CAD\", "\CAD\blocks\") varTel = InStrRev(MapNameNew, "blocks") BlkMapName = Left(MapNameNew, (varTel + 6)) ThisDrawing.Utility.GetEntity objEnt, varPnt, "select block" If objEnt.ObjectName = "AcDbBlockReference" Then BlkName = objEnt.Name Else MsgBox "selected item is not a block": Call Start End If ' Looks for the block in de map Blocks in current workmap DwgName = BlkMapName + BlkName + ".dwg" MsgBox DwgName If Dir(DwgName) <> "" Then ThisDrawing.Application.Documents.Open DwgName Else MsgBox ("Block bestaat niet in map. ") End If End Sub Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.