Block Name & QTY will automatically write by given condition path to excel.

ashwin-rajeshXYJW4 · ‎08-29-2023

Dear All,

Please advise i have .lisp program for export the block name and qty to export new excel .
but i want automatic to write my BOQ Excel sheet based on VLOOKUP condition .

)block name = Reference ID) so i want to fill the QTY value to excel

i want to block data inside of below excel sheet

please help me.

(defun c:blk (/ _doc nm ds b ly f lst fl op)

(vlax-for l (vla-get-layouts
(setq _doc
(vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for o (vla-get-block l)
(if (and (eq (vla-get-objectname o) "AcDbBlockReference")
(setq nm (vla-get-effectivename o))
(setq ds
(if (vlax-property-available-p
(setq b (vla-item (vla-get-blocks _doc) nm))
'comments)
(vla-get-comments b)
"")
)
(setq ly (vla-get-layer o))
)
(if (vl-some '(lambda (x)
(and (eq ly (car x))
(eq nm (cadr x))
(setq f x)
)
)
lst)
(setq lst (subst (list ly nm (1+ (caddr f)) ds) f lst))
(setq lst (cons (list ly nm 1 ds) lst))
)
)
)
)
(setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
(cond ((not lst)
(alert "Couldn't find any block in this drawing !!"))
((and (setq fl (getfiled "Specify new Excel file name" "NewExcel.csv" "csv" 1))
(setq op (open fl "w"))
)
(write-line "Layer Name,Block Name,QTY,Description" op)
(mapcar '(lambda (x)
(write-line
(strcat (car x) ","
(cadr x) ","
(itoa (caddr x)) ","
(nth 3 x))
op))
lst)
(close op)
)
)
(princ)
)(vl-load-com)

devitg · ‎08-29-2023

@ashwin-rajeshXYJW4 Please upload your dwg and xls

ashwin-rajeshXYJW4 · ‎08-29-2023

@devitg Thanks for your reply,

Please find the attached sample file for above my question.

block name = reference id so i want to fill the QTY value automatically from AutoCAD to excel sheet

Sea-Haven · ‎08-30-2023

Yes can be done, a couple of questions, some of the values in the excel do not appear to have a matching item in the dwg, so how do we associate Tray 1st size to "10007" ?

ashwin-rajeshXYJW4 · ‎08-30-2023

@Sea-Haven ,
Thanks for your response. 10007 Tray 1st- block does not present in the dwg. so excel no need to fill that unavailable QTY, (all not matching data ignore in excel sheet).

i want only matching data "if Block name equal to Reference Id" means QTY should be autofill.

Thank you.

Sea-Haven · ‎08-31-2023

Ok so sort the data on block name please confirm.

ashwin-rajeshXYJW4 · ‎08-31-2023

@Sea-Haven,

Thanks for your fast response,

Yes, I conform. Reference ID is the block name in AutoCAD, I want QTY value to excel sheet automatically.
Please find the attached image for your reference.

Thank you.

Sea-Haven · ‎09-01-2023

Try this, dont have excel open as it will open a blank Excel.

; 2/09
; By Alan H Aug 2023


; By Gile
(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun putcells (cells/ )
(repeat (- (length lst3) 2)
  (putcell (strcat "A" (rtos row 2 0)) (nth 0 cells))
  (putcell (strcat "B" (rtos row 2 0)) (nth 1 cells))
  (putcell (strcat "C" (rtos row 2 0)) (nth 2 cells))
  (putcell (strcat "D" (rtos row 2 0)) (nth 3 cells))
  (putcell (strcat "E" (rtos row 2 0)) (nth 4 cells))
  (setq x (1+ x) row (1+ row))
)
)

(defun putcell (cellname val1 / )
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)

(defun c:ashwin ( / ss lst lst2 lst3 )
(prompt "Pick the objects ")
(setq ss (ssget '((0 . "Insert"))))
(setq lst '())
(repeat (setq x (sslength ss))
  (setq bname (cdr (assoc 2 (entget (ssname ss (setq x (- x 1)))))))
    (setq lst (cons (list bname) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))

(setq lst3 '())
(setq lst2 (remove_doubles lst))
(foreach val lst2
  (setq cnt (my-count  val lst))
  (setq lst3 (cons (list  (nth 0 val) cnt) lst3))
)
(setq lst3 (reverse lst3))

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)


(putcell  "A1" "SI NO")
(putcell "B1" "QTY")
(putcell "C1" "Item Name")
(putcell "D1" "SUPPLIER")
(putcell "E1" "Reference Id")
(setq x 0  row 2)
(repeat (length lst3)
  (putcell (strcat "A" (rtos row 2 0)) (rtos (1+ x) 2 0))
  (putcell (strcat "B" (rtos row 2 0)) (nth 1 (nth x lst3)))
  (putcell (strcat "C" (rtos row 2 0)) (strcat "Tray" (rtos (1+ x) 2 0) " Size"))
  (putcell (strcat "D" (rtos row 2 0)) "NA")
  (putcell (strcat "E" (rtos row 2 0)) (nth 0 (nth x lst3)))
  (setq x (1+ x) row (1+ row))
)

(princ)
)

ashwin-rajeshXYJW4 · ‎09-02-2023

@Sea-Haven , Thank you so much for your solution.

I'm really surprised your given solution. I want to just modify in little bit.

I dont want Export to Auto create- New Excel file for my data. I want to replace the QTY data only my given existing file. if selected path ( because we using standard format )

Example: Once .lisp file is loaded

Step-1 command

Step-2 Select the Excel file( using standard excel)

Step-3 Block QTY Data replaced successfully ( select excel file into fill data only QTY value )

Thanks for your valuable helps and time.

Sea-Haven · ‎09-02-2023

Your sample file started at column E is there a reason for that ? What is in A-D. Can though start at E if required.

The code will work as is, if you open an Excel 1st, I can change to select a file to use. Change this line by adding semicolon at start.

;(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)

Remove the lines about adding the 1st row.

(putcell "A1" "SI NO")
(putcell "B1" "QTY")
(putcell "C1" "Item Name")
(putcell "D1" "SUPPLIER")
(putcell "E1" "Reference Id")

If it must start at E then change column names

(repeat (length lst3)
  (putcell (strcat "A" (rtos row 2 0)) (rtos (1+ x) 2 0))
  (putcell (strcat "B" (rtos row 2 0)) (nth 1 (nth x lst3)))
  (putcell (strcat "C" (rtos row 2 0)) (strcat "Tray" (rtos (1+ x) 2 0) " Size"))
  (putcell (strcat "D" (rtos row 2 0)) "NA")
  (putcell (strcat "E" (rtos row 2 0)) (nth 0 (nth x lst3)))
  (setq x (1+ x) row (1+ row))
)

hosneyalaa · ‎09-03-2023

@ashwin-rajeshXYJW4

TRY

(defun c:blk_TO_EXCEEL (/       ADOC    B       CELL    CLL     DS
                        EXCDATA EXCELAPP        F       FL      I
                        ICOL    IROW    IROWS   LST     LW-LST  LY
                        MAKE_LW NM      SHT     WBK     XLCELL  XLFRANGE
                        XLRANGE XLRANGEC        _DOC
                       )


  (vl-load-com)


  (vlax-for l (vla-get-layouts
                (setq _doc
                       (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of setq
              ) ;_ end of vla-get-layouts
    (vlax-for o (vla-get-block l)
      (if (and (eq (vla-get-objectname o) "AcDbBlockReference")
               (setq nm (vla-get-effectivename o))
               (setq ds
                      (if (vlax-property-available-p
                            (setq b (vla-item (vla-get-blocks _doc) nm))
                            'comments
                          ) ;_ end of vlax-property-available-p
                        (vla-get-comments b)
                        ""
                      ) ;_ end of if
               ) ;_ end of setq
               (setq ly (vla-get-layer o))
          ) ;_ end of and
        (if (vl-some '(lambda (x)
                        (and (eq ly (car x))
                             (eq nm (cadr x))
                             (setq f x)
                        ) ;_ end of and
                      ) ;_ end of lambda
                     lst
            ) ;_ end of vl-some
          (setq lst (subst (list ly nm (1+ (caddr f)) ds) f lst))
          (setq lst (cons (list ly nm 1 ds) lst))
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for



  (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))

  (cond ((not lst)
         (alert "Couldn't find any block in this drawing !!")
        )
        ((setq fl (getfiled "Select Excel File:"
                            (getvar "dwgprefix")
                            "XLSX;XLS"
                            4
                  ) ;_ end of getfiled
         ) ;_ end of and XLSX;XLS
         (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
         (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
         (setq Wbk (vl-catch-all-apply
                     'vla-open
                     (list (vlax-get-property ExcelApp "WorkBooks") fl)
                   ) ;_ end of vl-catch-all-apply
         ) ;_ end of setq
         (setq Sht (vl-catch-all-apply
                     'vlax-get-property
                     (list (vlax-get-property Wbk "Sheets") "Item" 1)
                   ) ;_ end of vl-catch-all-apply
         ) ;_ end of setq
         (vla-put-visible ExcelApp :vlax-true)
         (setq xlRangeC (vlax-invoke-method Sht "Activate"))
         (setq xlRange (vlax-get-property Sht "Range" "I2:I2000"))
         (vlax-invoke-method xlRange "Select")
         (setq iCol (vlax-get-property xlRange "Column"))
         (setq iRows (vlax-get-property
                       (vlax-get-property xlRange "Rows")
                       "Count"
                     ) ;_ end of vlax-get-property
               iRow  (vlax-get-property xlRange "Row")
         ) ;_ end of setq
         (setq cll (vlax-get-property ExcelApp 'Cells))
         (setq

           ExcData (vlax-safearray->list
                     (vlax-variant-value
                       (vlax-get-property xlRange 'Value)
                     ) ;_ end of vlax-variant-value
                   ) ;_ end of vlax-safearray->list
         ) ;_ end of setq
         (setq
           ExcData
            (mapcar
              (function (lambda (x) (mapcar 'vlax-variant-value x)))
              ExcData
            ) ;_ end of mapcar
         ) ;_ end of setq


                                                  ;(setq lw-lst nil)
         (foreach pt ExcData
           (setq lw-lst (append (list (car pt)) lw-lst))

         ) ;_ end of foreach
         (setq make_lw (reverse (vl-remove nil lw-lst)))

         (setq i 0)
         (repeat (length lst)
           (setq xlCell (vlax-invoke-method
                          xlRange
                          "Find"
                          (vlax-make-variant (cadr (nth i lst)))
                          xlFRange
                          -4163
                          1
                          1
                          1
                          nil
                          nil
                        ) ;_ end of vlax-invoke-method
           ) ;_ end of setq
           (setq cell (vlax-variant-value
                        (vlax-get-property
                          cll
                          'Item
                          (vlax-get-property xlCell "Row")
                          (vlax-get-property xlCell "Column")
                        ) ;_ end of vlax-get-property
                      ) ;_ end of vlax-variant-value
           ) ;_ end of setq

           (vlax-put-property
             cll
             "Item"
             (vlax-get-property xlCell "Row")
             (- (vlax-get-property xlCell "Column") 3)
             (vl-princ-to-string (rtos (caddr (nth i lst)) 2 2))
           ) ;_ end of vlax-put-property



           (setq i (1+ i))





         ) ;_ end of repeat








        )
  ) ;_ end of cond









  (princ)
) ;_ end of defun
(vl-load-com)
 ;|«Visual LISP© Format Options»
(72 2 50 2 T "end of " 60 9 1 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

ashwin-rajeshXYJW4 · ‎09-03-2023

@hosneyalaa& @Sea-Haven ,

Thanks for your response,

Amazing, working well both solutions are useful to me.

Thanks for your variable times and correct solution.

ashwin-rajeshXYJW4 · ‎09-04-2023

@hosneyalaa ,

data successfully Filled to excel but AutoCAD Commends showing error after data "BLKTO bad argument type: VLA-OBJECT nil" how to clear this error, thanks

hosneyalaa · ‎09-04-2023

@ashwin-rajeshXYJW4

I don't have any mistakes look at the picture

Give me an example complete The drawing

ashwin-rajeshXYJW4 · ‎09-04-2023

@hosneyalaa ,
Thanks for your fast response,

Actually, I'm using my standard similar excel and CAD Blocks- Your give codes working 100% but just notified after completed progress, AutoCAD Command lines in showing error.

I want just to ignore/ hide this error, but all data filled to excel.

Thank you.

hosneyalaa · ‎09-04-2023

@ashwin-rajeshXYJW4

Are you
Try lisp On the same The drawing Which is attached
Or other?
You must send the same The drawing you are trying on

I can't guess the reason

ashwin-rajeshXYJW4 · ‎09-04-2023

@hosneyalaa ,

Thanks for your help,

.Im used this lisp to another dwg and excel ( standard file) . I'm really sorry i dont have access to share that file.

in the dwg have unwanted dynamic blocks are presented ( that block name not matching to excel reference id ) I find this is the problem.

Please advise for this problem, thanks

i want to ignore this error message only. your give code working nicely.
Please advice, thanks

hosneyalaa · ‎09-05-2023

HI @ashwin-rajeshXYJW4

TRY

(defun c:blk_TO_EXCEEL (/       ADOC    B       CELL    CLL     DS
                        EXCDATA EXCELAPP        F       FL      I
                        ICOL    IROW    IROWS   LST     LW-LST  LY
                        MAKE_LW NM      SHT     WBK     XLCELL  XLFRANGE
                        XLRANGE XLRANGEC        _DOC
                       )


  (vl-load-com)


  (vlax-for l (vla-get-layouts
                (setq _doc
                       (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of setq
              ) ;_ end of vla-get-layouts
    (vlax-for o (vla-get-block l)
      (if (and (eq (vla-get-objectname o) "AcDbBlockReference")
               (setq nm (vla-get-effectivename o))
               (setq ds
                      (if (vlax-property-available-p
                            (setq b (vla-item (vla-get-blocks _doc) nm))
                            'comments
                          ) ;_ end of vlax-property-available-p
                        (vla-get-comments b)
                        ""
                      ) ;_ end of if
               ) ;_ end of setq
               (setq ly (vla-get-layer o))
          ) ;_ end of and
        (if (vl-some '(lambda (x)
                        (and (eq ly (car x))
                             (eq nm (cadr x))
                             (setq f x)
                        ) ;_ end of and
                      ) ;_ end of lambda
                     lst
            ) ;_ end of vl-some
          (setq lst (subst (list ly nm (1+ (caddr f)) ds) f lst))
          (setq lst (cons (list ly nm 1 ds) lst))
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for



  (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))

  (cond ((not lst)
         (alert "Couldn't find any block in this drawing !!")
        )
        ((setq fl (getfiled "Select Excel File:"
                            (getvar "dwgprefix")
                            "XLSX;XLS"
                            4
                  ) ;_ end of getfiled
         ) ;_ end of and XLSX;XLS
         (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
         (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
         (setq Wbk (vl-catch-all-apply
                     'vla-open
                     (list (vlax-get-property ExcelApp "WorkBooks") fl)
                   ) ;_ end of vl-catch-all-apply
         ) ;_ end of setq
         (setq Sht (vl-catch-all-apply
                     'vlax-get-property
                     (list (vlax-get-property Wbk "Sheets") "Item" 1)
                   ) ;_ end of vl-catch-all-apply
         ) ;_ end of setq
         (vla-put-visible ExcelApp :vlax-true)
         (setq xlRangeC (vlax-invoke-method Sht "Activate"))
         (setq xlRange (vlax-get-property Sht "Range" "I2:I2000"))
         (vlax-invoke-method xlRange "Select")
         (setq iCol (vlax-get-property xlRange "Column"))
         (setq iRows (vlax-get-property
                       (vlax-get-property xlRange "Rows")
                       "Count"
                     ) ;_ end of vlax-get-property
               iRow  (vlax-get-property xlRange "Row")
         ) ;_ end of setq
         (setq cll (vlax-get-property ExcelApp 'Cells))
         (setq

           ExcData (vlax-safearray->list
                     (vlax-variant-value
                       (vlax-get-property xlRange 'Value)
                     ) ;_ end of vlax-variant-value
                   ) ;_ end of vlax-safearray->list
         ) ;_ end of setq
         (setq
           ExcData
            (mapcar
              (function (lambda (x) (mapcar 'vlax-variant-value x)))
              ExcData
            ) ;_ end of mapcar
         ) ;_ end of setq


                                                  ;(setq lw-lst nil)
         (foreach pt ExcData
           (setq lw-lst (append (list (car pt)) lw-lst))

         ) ;_ end of foreach
         (setq make_lw (reverse (vl-remove nil lw-lst)))

         (setq i 0)
         (repeat (length lst)
           
           (setq xlCell (vlax-invoke-method
                          xlRange
                          "Find"
                          (vlax-make-variant (cadr (nth i lst)))
                          xlFRange
                          -4163
                          1
                          1
                          1
                          nil
                          nil
                        ) ;_ end of vlax-invoke-method
           ) ;_ end of setq

           (IF (/= xlCell nil)
             ( PROGN 

            
           (setq cell (vlax-variant-value
                        (vlax-get-property
                          cll
                          'Item
                          (vlax-get-property xlCell "Row")
                          (vlax-get-property xlCell "Column")
                        ) ;_ end of vlax-get-property
                      ) ;_ end of vlax-variant-value
           ) ;_ end of setq

           (vlax-put-property
             cll
             "Item"
             (vlax-get-property xlCell "Row")
             (- (vlax-get-property xlCell "Column") 3)
             (vl-princ-to-string (rtos (caddr (nth i lst)) 2 2))
           ) ;_ end of vlax-put-property


             ))



           (setq i (1+ i))





         ) ;_ end of repeat








        )
  ) ;_ end of cond









  (princ)
) ;_ end of defun
(vl-load-com)
 ;|«Visual LISP© Format Options»
(72 2 50 2 T "end of " 60 9 1 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

ashwin-rajeshXYJW4 · ‎09-05-2023

@hosneyalaa Thank you for your solution, code working very well

Community

Block Name &amp; QTY will automatically write by given condition path to excel.