Re: Lisp to export polyline area and length from Autocad to excel

sajid727 · ‎04-24-2024

With the help of friends in this Forum, i have got lisp to get area and length from Autocad drawings and export to excel in xlsx. format. But i still need some modifications in the lisp to suit my needs. So i would like to request if anybody can help with the following concerns-

1) Once a polyline is selected, its color should change, so as to avoid duplication.

2) In the excel sheet, Room area should be displayed before the Room perimeter.

3) Once the selection of polylines is done and exported to excel sheet using Room_Data_Out.lsp, and then when i make another new selection of polylines in the same drawing, the results are exported to a new excel file. So each time a new excel file is created. I would like to have all the areas and perimeters for the same drawing in ONE excel file.

Lisps can be found in attachment for your kind review and modification.

guzman748 · ‎04-25-2024

I only have a solution for your first question. Here is a line I've used in my lisps for a similar purpose. You can delete lt and the following input if you don't want to change the linetype scale.

(command "chprop" ent "" "c" "INPUTDESIREDCOLOR" "lt" "ByLayer" "La" "DESIREDLAYER" "")

Sea-Haven · ‎04-25-2024

Re order look at this ("HANDLE" "ROOM_NAME" "ROOM_FLOOR" "ROOM_PERIMETER" "ROOM_AREA") I have not tested but changing the order should change export to excel. Occurs twice in code.

This calls excel and should be done out side of the Room_data_out and rename defun to not have the C :

(defun c:roomout ( / )
(setq xls (vlax-get-or-create-object "Excel.Application"))
(defun room_data_out ( / 
...............
)
(room_data_out)
(princ)
)

So need a short defun at start that calls the new room out. The defun itself has a "ADD" a sheet so it should work whilst you have Excel open. NOT TESTED

Changing dwg's or closing and reopen same with Excel will not work needs all together lots more if's and but's.

I do this task in a different way not using Ldata.

sajid727 · ‎04-27-2024

Thanks guzman748 for your reply. I am new to lisp. Could you please make changes in the lisps I had attached in my my original post and repost it.

sajid727 · ‎04-27-2024

Thanks Sea-Heaven for yours reply. I am new to lisp. Could you please modify lisp I posted and repost it.

Sea-Haven · ‎04-27-2024

This is not tested as need a real dwg. But give it a try.

(defun ROOM_DATA_OUT (file_output / sel file_output doc xls wks column count nb ename k_list)
	(setq
		sel (ssget "_X" '((0 . "*POLYLINE") (8 . "AREA_ROOM") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>")))
	)

	(cond
		((and sel file_output)
			(setq doc (vla-get-activedocument (vlax-get-acad-object)))
			(vla-startundomark doc)
			
			(vlax-invoke (vlax-get xls 'workbooks) 'Add)
			(vlax-put xls 'Visible :vlax-true)
			(setq
				wks (vlax-get xls 'ActiveSheet)
				column 65
				count 1
			)
			(vlax-put (vlax-get-property wks 'range (strcat "A1:E" (itoa (sslength sel)))) 'Cells "")
			(foreach el '("HANDLE" "ROOM_NAME" "ROOM_FLOOR" "ROOM_PERIMETER" "ROOM_AREA")
				(vlax-put (vlax-get-property wks 'range (strcat (chr column) (itoa count))) 'value el)
				(setq column (1+ column))
			)
			(repeat (setq nb (sslength sel))
				(setq
					ename (ssname sel (setq nb (1- nb)))
					k_list (list (cons "HANDLE" (strcat "'" (cdr (assoc 5 (entget ename))))))
				)
				(foreach el '("ROOM_NAME" "ROOM_FLOOR" "ROOM_PERIMETER" "ROOM_AREA")
					(setq k_list (cons (cons el (vlax-ldata-get ename el)) k_list))
				)
				(setq
					count (1+ count)
					column 65
				)
				(foreach el (reverse (mapcar 'cdr k_list))
					(vlax-put (vlax-get-property wks 'range (strcat (chr column) (itoa count))) 'value el)
					(setq
						column (1+ column)
					)
				)
				(setq k_list nil)
			)
			(mapcar 'vlax-release-object (list wks xls))
			(gc)
			(vla-endundomark doc)
		)
	)
	(prin1)
)

(defun c:roomout ( / xls)
(setq xls (vlax-get-or-create-object "Excel.Application"))
(setq fname (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".xlsm")

(ROOM_DATA_OUT fname)
(if (not (vlax-object-released-p XLS))(progn(vlax-release-object XLS)(setq XLS nil)))
(princ)
)

hosneyalaa · ‎04-27-2024

try

(vl-load-com)
(defun c:ROOM_DATA ( / AcDoc Space old_lay pt sel ent vla_obj)
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(cond
		((null (tblsearch "LAYER" "AREA_ROOM"))
			(vlax-put (vla-add (vla-get-layers AcDoc) "AREA_ROOM") 'color 3)
		)
	)
	(setq old_lay (getvar "CLAYER"))
	(setvar "CLAYER" "AREA_ROOM")
	(setq pt (getpoint "\nFirst point of polyline or enter for select one: "))
	(if pt
		(command "_.pline" pt
			(while (not (zerop (getvar "cmdactive")))
				(command pause)
			)
		)
		(while (not (setq sel (ssget "_+.:E:S" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>"))))))
	)
	(cond
		(sel
			(setq
				ent (ssname sel 0)
				vla_obj (vlax-ename->vla-object ent)
			)
			(vlax-put-property vla_obj "Layer" "AREA_ROOM")
		)
		(T
		 (setq ent (entlast) vla_obj (vlax-ename->vla-object ent))
		 (vlax-put-property vla_obj "color" 1)
		 )
	)
	(vlax-ldata-put vla_obj "ROOM_NAME" (getstring T "\nName of room : "))
	(vlax-ldata-put vla_obj "ROOM_AREA" (vlax-get-property vla_obj "Area"))
	(vlax-ldata-put vla_obj "ROOM_PERIMETER" (vlax-get-property vla_obj "Length"))
	(vlax-ldata-put vla_obj "ROOM_FLOOR" (getstring T "\nFloor of room : "))
	(setvar "CLAYER" old_lay)
	(princ "\nPolyline have this data:")
	(print (vlax-ldata-list vla_obj))
	(prin1)
)

hosneyalaa · ‎04-27-2024

try

(defun c:ROOM_DATA_OUT ( / sel file_output doc xls wks column count nb ename k_list)
	(setq
		sel (ssget "_X" '((0 . "*POLYLINE") (8 . "AREA_ROOM") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>")))
		file_output (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4))(rtos (getvar "CDATE") 2 6) ".xlsm")
		)
	(cond
		((and sel file_output)
			(setq doc (vla-get-activedocument (vlax-get-acad-object)))
			(vla-startundomark doc)
			(setq xls (vlax-get-or-create-object "Excel.Application"))
			(vlax-invoke (vlax-get xls 'workbooks) 'Add)
			(vlax-put xls 'Visible :vlax-true)
			(setq
				wks (vlax-get xls 'ActiveSheet)
				column 65
				count 1
			)
			(vlax-put (vlax-get-property wks 'range (strcat "A1:E" (itoa (sslength sel)))) 'Cells "")
			(foreach el '("HANDLE" "ROOM_NAME" "ROOM_FLOOR" "ROOM_AREA" "ROOM_PERIMETER" )
				(vlax-put (vlax-get-property wks 'range (strcat (chr column) (itoa count))) 'value el)
				(setq column (1+ column))
			)
			(repeat (setq nb (sslength sel))
				(setq
					ename (ssname sel (setq nb (1- nb)))
					k_list (list (cons "HANDLE" (strcat "'" (cdr (assoc 5 (entget ename))))))
				)
				(foreach el '("ROOM_NAME" "ROOM_FLOOR" "ROOM_AREA" "ROOM_PERIMETER" )
					(setq k_list (cons (cons el (vlax-ldata-get ename el)) k_list))
				)
				(setq
					count (1+ count)
					column 65
				)
				(foreach el (reverse (mapcar 'cdr k_list))
					(vlax-put (vlax-get-property wks 'range (strcat (chr column) (itoa count))) 'value el)
					(setq
						column (1+ column)
					)
				)
				(setq k_list nil)
			)
			(mapcar 'vlax-release-object (list wks xls))
			(gc)
			(vla-endundomark doc)
		)
	)
	(prin1)
)

sajid727 · ‎04-28-2024

Thank you very much hosneyalaa for your lisp. I just have a request if it possible to change color of polyline when it is selected, so as to avoid duplication in selection. Can you please include this in your lisp and post your lisp again.

One more thing i would like to mention in the ROOM_DATA_OUT lisp, the last room selected appears on the top and the first room selected appears at the last. I would like first room selection to be first and the last room selected to be at last. Please see attached excel sheet, I selected room No-1 at first and room No-4 at last.

hosneyalaa · ‎04-28-2024

try

(vl-load-com)
(defun c:ROOM_DATAr (/ AcDoc Space old_lay pt sel ent vla_obj)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
	  (if (= 1 (getvar "CVPORT"))
	    (vla-get-PaperSpace AcDoc)
	    (vla-get-ModelSpace AcDoc)
	  )
  )
  (cond
    ((null (tblsearch "LAYER" "AREA_ROOM"))
     (vlax-put (vla-add (vla-get-layers AcDoc) "AREA_ROOM")
	       'color
	       3
     )
    )
  )
  (setq old_lay (getvar "CLAYER"))
  (setvar "CLAYER" "AREA_ROOM")
  (setq	pt (getpoint
	     "\nFirst point of polyline or enter for select one: "
	   )
  )
  (if pt
    (command "_.pline"
	     pt
	     (while (not (zerop (getvar "cmdactive")))
	       (command pause)
	     )
    )
    (while (not	(setq sel (ssget "_+.:E:S"
				 '((0 . "*POLYLINE")
				   (-4 . "<NOT")
				   (-4 . "&")
				   (70 . 120)
				   (-4 . "NOT>")
				  )
			  )
		)
	   )
    )
  )
  (cond
    (sel
     (setq
       ent     (ssname sel 0)
       vla_obj (vlax-ename->vla-object ent)
     )
     (vlax-put-property vla_obj "Layer" "AREA_ROOM")
     (vlax-put-property vla_obj "color" 1)
    )
    (T
     (setq ent	   (entlast)
	   vla_obj (vlax-ename->vla-object ent)
     )
     (vlax-put-property vla_obj "color" 1)
    )
  )
  (vlax-ldata-put
    vla_obj
    "ROOM_NAME"
    (getstring T "\nName of room : ")
  )
  (vlax-ldata-put
    vla_obj
    "ROOM_AREA"
    (vlax-get-property vla_obj "Area")
  )
  (vlax-ldata-put
    vla_obj
    "ROOM_PERIMETER"
    (vlax-get-property vla_obj "Length")
  )
  (vlax-ldata-put
    vla_obj
    "ROOM_FLOOR"
    (getstring T "\nFloor of room : ")
  )
  (setvar "CLAYER" old_lay)
  (princ "\nPolyline have this data:")
  (print (vlax-ldata-list vla_obj))
  (prin1)
)

hosneyalaa · ‎04-28-2024

try

(defun c:ROOM_DATA_OUTs
       (/ sel file_output doc xls wks column count nb ename k_list)
  (setq
    sel		(ssget "_X"
		       '((0 . "*POLYLINE")
			 (8 . "AREA_ROOM")
			 (-4 . "<NOT")
			 (-4 . "&")
			 (70 . 120)
			 (-4 . "NOT>")
			)
		)
    file_output	(strcat	(getvar "DWGPREFIX")
			(substr	(getvar "DWGNAME")
				1
				(- (strlen (getvar "DWGNAME")) 4)
			)
			(rtos (getvar "CDATE") 2 6)
			".xlsm"
		)
  )
  (cond
    ((and sel file_output)
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (vla-startundomark doc)
     (setq xls (vlax-get-or-create-object "Excel.Application"))
     (vlax-invoke (vlax-get xls 'workbooks) 'Add)
     (vlax-put xls 'Visible :vlax-true)
     (setq
       wks    (vlax-get xls 'ActiveSheet)
       column 65
       count  1
     )
     (vlax-put (vlax-get-property
		 wks
		 'range
		 (strcat "A1:E" (itoa (sslength sel)))
	       )
	       'Cells
	       ""
     )
     (foreach el '("HANDLE"	     "ROOM_NAME"
		   "ROOM_FLOOR"	     "ROOM_AREA"
		   "ROOM_PERIMETER"
		  )
       (vlax-put (vlax-get-property
		   wks
		   'range
		   (strcat (chr column) (itoa count))
		 )
		 'value
		 el
       )
       (setq column (1+ column))
     )







     (setq
       ptLst (reverse
	       (mapcar
		 'cdr
		 (vl-sort
		   (mapcar '(lambda (x)
			      (cons (vlax-ldata-get x "ROOM_NAME") x)
			    )

			   (mapcar 'cadr (ssnamex sel))
		   )
		   '(lambda (a b) (< (car a) (car b)))
		 )
	       )
	     )
     )



     (repeat (setq nb (length ptLst))
       (setq
	 ename	(nth (setq nb (1- nb)) ptLst)
	 k_list	(list (cons "HANDLE"
			    (strcat "'" (cdr (assoc 5 (entget ename))))
		      )
		)
       )
       (foreach	el
		'("ROOM_NAME" "ROOM_FLOOR" "ROOM_AREA" "ROOM_PERIMETER")
	 (setq k_list (cons (cons el (vlax-ldata-get ename el)) k_list))
       )
       (setq
	 count	(1+ count)
	 column	65
       )
       (foreach	el (reverse (mapcar 'cdr k_list))
	 (vlax-put (vlax-get-property
		     wks
		     'range
		     (strcat (chr column) (itoa count))
		   )
		   'value
		   el
	 )
	 (setq
	   column (1+ column)
	 )
       )
       (setq k_list nil)
     )
     (mapcar 'vlax-release-object (list wks xls))
     (gc)
     (vla-endundomark doc)
    )
  )
  (prin1)
)

sajid727 · ‎04-29-2024

Thanks hosneyalaa ! you are an expert. This is what i wanted. Just want to ask you one more thing- if it is possible to get the result area and perimeter in 1 excel sheet, because when i get area and perimeter using ROOM_DATA_OUTs command and then make another new selection of polylines, it opens another new excel sheet. So every time new selection of polylines is made, a new excel sheet is created.

Sea-Haven · ‎04-29-2024

This line adds a new worksheet.

(vlax-invoke (vlax-get xls 'workbooks) 'Add)

Need to use possibly something like this.

(setq myxl (vlax-get-object "Excel.Application"))
; it will fail if Excel is not open so can then check again
(if (= myxl nil)
(progn
(setq myxl (vlax-get-or-create-object "excel.Application"))
;this will open myxl wether itexists or will start a new session and needs the "ADD"
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; opens a new xl
)
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

sajid727 · ‎04-29-2024

Hello Sea-Haven. Thanks for your advice, can you please update the lisp with the changes you suggested and repost it.

hosneyalaa · ‎04-30-2024

TRY

(defun c:ROOM_DATA_OUTsS
       (/ COLUMN COUNT DOC ENAME FILE_OUTPUT K_LIST NB PTLST SEL WKS X XLBOOK XLRANGE XLS)
  (setq
    sel		(ssget "_X"
		       '((0 . "*POLYLINE")
			 (8 . "AREA_ROOM")
			 (-4 . "<NOT")
			 (-4 . "&")
			 (70 . 120)
			 (-4 . "NOT>")
			)
		)
    file_output	(getfiled "Select Excel file :"
			  (getvar "dwgprefix")
			  "xlsx;xls"
			  16
		)
  )
  (cond
    ((and sel file_output)
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (vla-startundomark doc)
     (setq xls (vlax-get-or-create-object "Excel.Application"))

     (vlax-put xls 'Visible :vlax-true)

     (not
       (vl-catch-all-error-p
	 (vl-catch-all-apply
	   (function (lambda ()
		       (setq
			 xlBook	(vlax-invoke-method
				  (vlax-get-property xls 'WorkBooks)
				  "Open"
				  file_output
				)
		       )
		     )
	   )
	 )
       )
     )
     (setq
       wks    (vlax-get xls 'ActiveSheet)
       column 65
       count  1
     )
     (vlax-put (vlax-get-property
		 wks
		 'range
		 (strcat "A1:E" (itoa (sslength sel)))
	       )
	       'Cells
	       ""
     )
     (foreach el '("HANDLE"	     "ROOM_NAME"
		   "ROOM_FLOOR"	     "ROOM_AREA"
		   "ROOM_PERIMETER"
		  )
       (vlax-put (vlax-get-property
		   wks
		   'range
		   (strcat (chr column) (itoa count))
		 )
		 'value
		 el
       )
       (setq column (1+ column))
     )







     (setq
       ptLst (reverse
	       (mapcar
		 'cdr
		 (vl-sort
		   (mapcar '(lambda (x)
			      (cons (vlax-ldata-get x "ROOM_NAME") x)
			    )

			   (mapcar 'cadr (ssnamex sel))
		   )
		   '(lambda (a b) (< (car a) (car b)))
		 )
	       )
	     )
     )



     (repeat (setq nb (length ptLst))
       (setq
	 ename	(nth (setq nb (1- nb)) ptLst)
	 k_list	(list (cons "HANDLE"
			    (strcat "'" (cdr (assoc 5 (entget ename))))
		      )
		)
       )
       (foreach	el
		'("ROOM_NAME" "ROOM_FLOOR" "ROOM_AREA" "ROOM_PERIMETER")
	 (setq k_list (cons (cons el (vlax-ldata-get ename el)) k_list))
       )
       (setq
	 count	(1+ count)
	 column	65
       )
       (foreach	el (reverse (mapcar 'cdr k_list))
	 (vlax-put (vlax-get-property
		     wks
		     'range
		     (strcat (chr column) (itoa count))
		   )
		   'value
		   el
	 )
	 (setq
	   column (1+ column)
	 )
       )
       (setq k_list nil)
     )
     (mapcar 'vlax-release-object (list wks xls))
     (gc)
     (vla-endundomark doc)
    )
  )
  (prin1)
)

Sea-Haven · ‎04-30-2024

In your code "Getfile" the file does not exist what then ? This is the case when making a new file. May need a open or check is file already open. I know looked at this before and need to do like 3 checks before proceeding. Maybe 1st step is as suggested is Excel open, if so check what is current file name. If correct use it else open a new or open a existing file.

I admit I went around in circles and never finished the checking in my Excel code. These may be helpful.

(defun openexist ( / )
(setq aH:ex "T")
(setq mySheet (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property myxl "Sheets") "Item" sheetName)))
(vlax-invoke-method mySheet "Activate")
)


(defun openexcel-sheetname (filename sheetname / )
(setq myBook (vl-catch-all-apply 'vla-open (list (vlax-get-property myXL "WorkBooks") fileName)))
(setq mySheet (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property myBook "Sheets") "Item" sheetName)))
(vlax-invoke-method mySheet "Activate")
)

(defun newexcelname (newname / )
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; opens a new xl
(vlax-put-property  (vlax-get-property (VLAX-get-property myxl "ActiveWorkbook") 'name) newname)
)

; set current worksheet  needs work
(defun setsheet ( sheetname / )
(setq xlSheets (vlax-get-property myxl "Worksheets"))
(setq curSheet (vlax-get-property xlSheets "Item" 1))  ; 1 is 1st sheet need names of sheets somehow.
; (vlax-get cursheet 'Name) returns name 
(vlax-invoke-method curSheet "Activate")
)

hosneyalaa · ‎04-30-2024

Thank you
The user must close the Excel file , Before starting the lisp

There are many ideas that can be combined with lisps , But there is no time

sajid727 · ‎05-01-2024

I tried, but it is not working.

sajid727 · ‎08-31-2024

I need help to get the length of polylines (walls) on point-to-point selection such that the color of polyline changes on selection and then export it to excel. Drawing attached.