Jump to content

Creating drawings form an excel list


barakar42

Recommended Posts

Hi,

 

I currently have a single DWG file with multiple layouts on that have viewports into model space that relate to different systems.

 

Would it be possible to use a list of drawing numbers from Excel to delete the layout tabs that aren't in that list?

 

 

Or if I need to split the single DWG into multiple files with a single layout tab each, would it be possible to combine them all back into one file once I've deleted all the irrelevant ones?

 

Chris

Link to comment
Share on other sites

If you can write Visual Basic, it should be easy enough to whip up some code to do this. Cycle through each layout, find the Excel entry for it, or delete it if not found. I don't think AutoLISP has the tools to access Excel, but who knows.

Link to comment
Share on other sites

With Access, Word and Excel it will work both ways. for Excel you can have Autocad populate and read cells and no doubt lots more, like wise you can have excel do all the work using excel VBA.

 

I don't think AutoLISP has the tools to access Excel, its very straight forward in Visual lisp to access excel and talk to it. have a look at Getexcel.lsp has lots of functions inside it.

 

Like wise this sample excel vba will draw objects in Autocad.

 

  
Sub Opendwg()
 
    Dim acadApp As Object
    Dim acadDoc As Object

 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
 
    'Check (again) if there is an AutoCAD object.
    If acadApp Is Nothing Then
        MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
        Exit Sub
    End If
    On Error GoTo 0
 
    'If there is no active drawing create a new one.
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
    End If
    On Error GoTo 0
  
    'Check if the active space is paper space and change it to model space.
    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
    End If

 End Sub
 
Public Sub addline(x1, y1, z1, x2, y2, z2)
  
 ' Create the line in model space
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim startpoint(0 To 2) As Double
    Dim endpoint(0 To 2) As Double
    Dim lineobj As Object

    startpoint(0) = x1: startpoint(1) = y1: startpoint(2) = z1
    endpoint(0) = x2: endpoint(1) = y2: endpoint(2) = z2

    Set lineobj = acadDoc.ModelSpace.addline(startpoint, endpoint)
    acadApp.ZoomExtents
    
    End Sub
    Public Sub addcirc(x1, y1, z1, rad)
  
 ' Create the circle in model space
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim cenpoint(0 To 2) As Double
   
    Dim circobj As Object

   cenpoint(0) = x1: cenpoint(1) = y1: cenpoint(2) = z1
    Set circobj = acadDoc.ModelSpace.addcircle(cenpoint, rad)
    acadApp.ZoomExtents
    
    End Sub
    
    
    Sub addpoly(cords, col)
    
    Dim acadApp As Object
    Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim oPline As Object
    
' add pline to Modelspace
Set oPline = acadDoc.ModelSpace.AddLightWeightPolyline(cords)
oPline.Color = col

End Sub
   
    Sub alan1()
    
   
' This example adds a line in model space
' Define the start and end points for the line
   
    px1 = 1
    px2 = 5
    py1 = 1
    py2 = 5
    pz1 = 0
    pz2 = 0
    

Call addline(px1, py1, pz1, px2, py2, pz2)

End Sub

 Sub alan2()
 
    px1 = 1
    py1 = 1
    pz1 = 0
    Radius = 8.5
 
 Call addcirc(px1, py1, pz1, Radius)

 End Sub
 
 Sub alan3()
 'Dim coords(0 To n) As Double
 Dim coords(0 To 5) As Double
 coords(0) = -6: coords(1) = 1:
 coords(2) = 3: coords(3) = 5:
 coords(4) = 7.55: coords(5) = 6.25:
 
 col = 1
    
 Call addpoly(coords, col)

 End Sub

 

Link to comment
Share on other sites

Thanks for that you two.

 

I've had a play with VBA, and can get it to delete a tab. However I can't get it to delete certain tabs

 

I have an excel sheet that compares two values and outputs a 1 or 0 depending if they match or not.  The problem is trying to get a variable value into the command line. 

 

This is what i've come up with for checking for a 1 or 0 and deleting tabs:

 

Sub delete_tabs()

On Error Resume Next
Dim acadCmd, match1num, match1 As String
Dim range1, total As Range
Dim I As Integer

 

'If Err.Description > vbNullString Then
'    Err.Clear
 '   Set ACAD = CreateObject("AutoCAD.Application")
'End If

 

total = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For I = 2 To total
    
    Set ACAD = GetObject(, "AutoCAD.Application")
    ACAD.Visible = True
    match1 = Sheets(1).Range("C" & I).Value
    match1num = Sheets(1).Range("B" & I).Value
     
    
        If match1 < 1 Then
            acadCmd = "-layout & d match1num "
            ACAD.ActiveDocument.SendCommand acadCmd & vbCr
       
        End If

Next I

 

Is there a way of getting the value for "match1num"s value into the command line?

Link to comment
Share on other sites

Did not look at your code to deep but if you look at visual lisp examples you can get a layout list and then check is name in another list if not delete. This is similar method to VBA.

 

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
  (setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq len (length plotabs))

 

 

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...