Auto draw box in autocad using ecxel data.

Auto draw box in autocad using ecxel data.

Tolearnlisp
Enthusiast Enthusiast
2,536 Views
8 Replies
Message 1 of 9

Auto draw box in autocad using ecxel data.

Tolearnlisp
Enthusiast
Enthusiast

Hi All,

 

Good Day!

Is there any possibilities to create a lisp file that draw box in array based from the data in excel file. See attached drawing and excel file for your reference. Thanks you all.

Data.PNGDrawing.PNG

0 Likes
Accepted solutions (2)
2,537 Views
8 Replies
Replies (8)
Message 2 of 9

Sea-Haven
Mentor
Mentor

Here is a example of how to draw objects from excel. This link is really good and shows you how also. I am not that good at VBA and will do a couple of amendments to this code as per youtube.

 

https://www.youtube.com/watch?v=754g0gcGsjY&feature=youtu.be

 

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

 

0 Likes
Message 3 of 9

Sea-Haven
Mentor
Mentor

2nd option copy the column to notepad save a file then run a lisp, It reads 1 line at a time saving the values then its normal Autocad lisp. For  simplicity just have 1 file name.

0 Likes
Message 4 of 9

Sea-Haven
Mentor
Mentor

Try this you need to check the dimensions in case I got something wrong as they are small numbers.

 

(defun c:tolearnlisp ( / A APP AREA COLS PT PT2 ROWS SPACX SPACY X1 X1-SEG XP Y1-SEG Y2 Y2-SEG YP ZX ZY)
(setq oldsnap (getvar 'osmode))
(setq fo (open "d:\\acadtemp\\tolearnlisp.txt" "R"))
(setq x (atof(read-line fo))
y (atof(read-line fo))
A (atof(read-line fo))
app (atof (read-line fo))
X1 (atof(read-line fo))
x1-seg (atof (read-line fo))
y2 (atof(read-line fo))
y2-seg (atof (read-line fo))
area (atof(read-line fo))
cols (atoi (read-line fo))
rows (atoi(read-line fo))
spacx (atof (read-line fo))
spacy (atof(read-line fo))
zx (atof (read-line fo))
zy (atof(read-line fo))
xp (atof (read-line fo))
yp (atof(read-line fo))
)
(close fo)
(setvar 'osmode 0)
(setq pt (getpoint "\nPick lower left corner"))
(command "rectang" pt (mapcar '+ pt (list X Y 0.0)))
(setq pt2 (mapcar '+ pt (list zx zy 0.0)))
(command "rectang" pt2 (mapcar '+ pt2 (list X1-seg Y2-seg 0.0)))
(command "array" "l" "" "R" rows cols (+ spacy y2-seg) (+ spacx y2-seg) )
(setvar 'osmode oldsnap)
(princ)
)
Message 5 of 9

Tolearnlisp
Enthusiast
Enthusiast

@Sea-Haven 

 

Thanks for creating this LISP. I tried to load in autocad but it shows this error "; error: bad argument type: FILE nil". could you tell me the reason. Thanks

0 Likes
Message 6 of 9

Sea-Haven
Mentor
Mentor
Accepted solution

You ned to have a basic idea about some functions in lisp one of those is using files, when people post code we have no idea how your computer is set up so for testing just make use of a known directory on our computer.

 

So lets pull this apart "d:\\acadtemp\\tolearnlisp.txt"

 

1st up I did say you had to copy the column of excel information to a file say using notepad. In this case I have chosen the name of the file to be "tolearnlisp.txt" see the sample I posted.

I have a directory on my 😧 drive called Acadtemp I use it to put anything that is really temporary.

I wanted a file to be read by the lisp called "tolearnlisp.txt" hence the "R" option meaning read.

So you need a place to save the txt file, its name and where its saved, change the lisp to suit.

 

Yes there is a function called "findfile" but I tried to keep it very simple for the moment.

 

Hope this helps.

 

0 Likes
Message 7 of 9

Moshe-A
Mentor
Mentor
Accepted solution

Nemie hi,

 

here is more 'invested' solution  to your 'problem'.

 

it works with excel CSV. you can save your xlsx file to CSV (Comma delimited) file. if excel complains it can't save a multi sheets file and\or has some incompatible properties you can accept the error message and pick OK. this will create a csv file that contain your interest data at the top of the file (and that's what is needed 😀)

 

the command AZC is also based on KEYS-CELL data list:

 

 

(setq KEYS-CELL (list
                    "X" 		; index=0
                    "Y" 		; index=1
                    "X1-segmented"	; index=2
                    "Y2-segmented"	; index=3
                    "number of columns"	; index=4
                    "number of rows"	; index=5
                    "Zx -segmented"	; index=6
                    "Zy -segmented"	; index=7
                   ); list
   )

 

 

it's a list of the data keys exactly as they found in your file. if you change the keys name in the file, you need to come here and fix the keys in KEYS-CELL also.

the order of keys are important, the first is index 0 and the last is 7 (total of 8). you can add here more keys to be read from the excel file but these keys (at this moment)  will not be use by this program.

 

Note: keys 6 + 7 has a space in them, to me it looks like a mistake but at this moment i left it as it is.

 

the program calculate on it's own the Spacing X, Spacing Y keys and that's why i didn't put them in KEYS-CELL data list. if there is a mistake in calculation, you will see it in the drawing.

 

the program starts by asking you to select the csv file + Specify lower left corner:  of the rectangle.

if there is a mismatch keys (between the csv file and KEYS-CELL) you will be notify.

 

enjoy

moshe

 

 

; Aperture siZe Calculator
(defun c:AZC (/ to-upcase read-csv-file check-data calc-space ; local function
                fpath p0 p1 KEYS-CELL f pos rowString cellValue csv-data^ wht hgt)

 ; convert list of strings to uppercase
 (defun to-upcase (lst)
  (mapcar
   '(lambda (str)
     (strcase str)
    )
    lst
  ); mapcar
 ); to-upcase

  
 (defun read-csv-file (/ read-cell ; local function
                         f rowString pos key cellValue lst)
   
  (defun read-cell (/ ch cell)
   (setq ch (substr rowString (setq pos (1+ pos)) 1) cell "") 
   (while (and (/= ch ",") (/= ch ""))
    (setq cell (strcat cell ch))
    (setq ch (substr rowString (setq pos (1+ pos)) 1)) 
   ); while

   cell 
  ); read-cell

   
  (if (setq f (open fpath "r"))
   (progn
    (setq rowString (read-line f))
   
    (while rowString
     (setq pos 0)

     (if (and
           (member (strcase (setq key (read-cell))) KEYS-CELL)
           (setq cellValue (read-cell))
         )
      (setq lst (cons (cons (strcase key) (atof cellValue)) lst))
     ); if
     
     (setq rowString (read-line f))
    ); while
   ); progn
  ); if
   
  lst
 ); read-csv-file



 (defun check-data (/ prtm ;| local function |; l)
   
  (defun prtm (lst)
   (foreach a lst (princ a))
  ); prtm
   
  (if (not
        (setq l
          (vl-remove-if
           'not
            (mapcar
             '(lambda (key)
               (if (null (assoc key csv-data^))
                key
               )
              )
             KEYS-CELL
            ); mapcar
          )
        )      
      )
   T ; all keys exist, return T
   (if (/= (length l) 0)
    (progn
     (vlr-beep-reaction)
     (prtm (list "\nthe following key(s) " l " not found in \n" fpath " file."))
     nil
    ); progn
   ); if
  ); if
 ); check-data


 (defun calc-space (p)
  (/ (- (cdr (assoc (nth (+ p 0) KEYS-CELL) csv-data^))
        (* (cdr (assoc (nth (+ p 6) KEYS-CELL) csv-data^)) 2)
        (* (cdr (assoc (nth (+ p 2) KEYS-CELL) csv-data^))
           (cdr (assoc (nth (+ p 4) KEYS-CELL) csv-data^))
        )
     ); subtract
     (1- (cdr (assoc (nth (+ p 4) KEYS-CELL) csv-data^)))
  ); divide
 ); calc-space
 
  
 ; here start (c:azc)
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (and
      (setq fpath (getfiled "Select excel file" "" "csv" 8))
      (setq p0 (getpoint "\nSpecify lower left corner: "))
     )
  (progn
   ; key cellValues on interest
   (setq KEYS-CELL (list
                    "X" 		; index=0
                    "Y" 		; index=1
                    "X1-segmented"	; index=2
                    "Y2-segmented"	; index=3
                    "number of columns"	; index=4
                    "number of rows"	; index=5
                    "Zx -segmented"	; index=6
                    "Zy -segmented"	; index=7
                   ); list
   ); KEYS-CELL

   ; convert to uppercase
   (setq KEYS-CELL (to-upcase KEYS-CELL))

   (if (and
         (setq csv-data^ (read-csv-file))
         (check-data)
       )
    (progn
     (command "._rectangle" "_None" p0 "_None" (mapcar '+ p0 (list (cdr (assoc (nth 0 KEYS-CELL) csv-data^)) (cdr (assoc (nth 1 KEYS-CELL) csv-data^)) 0.0)))
     (setq p1 (mapcar '+ p0 (list (cdr (assoc (nth 6 KEYS-CELL) csv-data^)) (cdr (assoc (nth 7 KEYS-CELL) csv-data^)) 0.0)))
     
     (command "._rectangle" "_None" p1 "_None" (mapcar '+ p1 (list (setq wht (cdr (assoc (nth 2 KEYS-CELL) csv-data^)))
                                                    (setq hgt (cdr (assoc (nth 3 KEYS-CELL) csv-data^))) 0.0)))

     (command "._array" "_si" "_last" "_Rectangular" (fix (cdr (assoc (nth 4 KEYS-CELL) csv-data^)))
                                                     (fix (cdr (assoc (nth 5 KEYS-CELL) csv-data^)))
                                                     (+ hgt (calc-space 0))
                                                     (+ wht (calc-space 1)))
    ); progn
   ); if
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:azc

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

0 Likes
Message 8 of 9

Tolearnlisp
Enthusiast
Enthusiast

@Sea-Haven 

 

Thank you for the detailed explanation and I was able to run the program which gave me the result I am looking for. Thanks for time and effort you poured out just to help me. See you again next time.

0 Likes
Message 9 of 9

Tolearnlisp
Enthusiast
Enthusiast

Hello @Moshe-A ,

 

Good Day!

I was thinking if we can modify the previous code by removing below part of the code 

(defun calc-space (p)
(/ (- (cdr (assoc (nth (+ p 0) KEYS-CELL) csv-data^))
(* (cdr (assoc (nth (+ p 6) KEYS-CELL) csv-data^)) 2)
(* (cdr (assoc (nth (+ p 2) KEYS-CELL) csv-data^))
(cdr (assoc (nth (+ p 4) KEYS-CELL) csv-data^))
)
); subtract
(1- (cdr (assoc (nth (+ p 4) KEYS-CELL) csv-data^)))
); divide
); calc-space

 

And add code in the KEYS-CELL like "Xp and Yp" for the spacing value that is directly get from the CSV file because the existing calc-space in the code is not suitable for single Row with few Column or single Column with multiple rows. 

(setq KEYS-CELL (list
"X" ; index=0
"Y" ; index=1
"X1" ; index=2
"Y1" ; index=3
"Number of Columns" ; index=4
"Number of Rows" ; index=5
"Zx" ; index=6
"Zy" ; index=7
"Xp" ; index=8
"Yp" ; index=9

); list
); KEYS-CELL

 

Please see attached Excel file samples. Thank you in advance.

 

0 Likes