Jump to content

How to open a drawing in lisp/vba


DAMO

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...