AutoLISP function similar to DataExtraction but with HANDLE

May 25, 2023

Good day. Requesting for an AutoLISP function that is similar with DataExtraction but also shows the object HANDLE.

Sequence:

• Select Objects (hopefully able to select all kinds of Objects)

• Prompts a Dialog Box where user can check/tick all the properties required by the user

• Prompts the next Dialog Box where user can adjust the order of data columns based on user preference

• Exports the data as CSV file and automatically opens an Excel File

Notes:

• say, user selects 995 objects; output will be an excel file with 996 rows (1 row header + 995 rows of data)

• The function sequence may be similar to PolyInfo by Lee Mac

The unique identifier of HANDLE is essential for tracking data; and can be used for practical applications in Engineering & Construction.

Thanks & regards to CADTutor community.

May 25, 2023

What properties are you interested in?

type of object, X, Y, layer, handle, ...?

May 25, 2023

Hi Emmanuel.

for the Objects:

I Mostly work with POLYLINES, SPLINES, REGIONS, BLOCKS, CIRCLES, POLYGONS

for the Properties:

LAYER, HYPERLINK (i use this property to put other parameters), HANDLE, COLOR, COUNT (assumed as '1' per row, since each row is unique), AREA, LENGTH

(if dialog box customization is a hassle, please neglect and just use these properties [kindly follow the same order])

It is my first time being exposed to LISP language and it amazes me how much work it can do; hoping to learn more about it.

Thanks & Regards.

May 26, 2023

Here's part of the request

If somebody wants to handle this dialog part, please do

This just saves the file with the same path and filename as the drawing.

command DWH for Dataextraction With Handle


; --- writeCSV ----------------------------------------------------------------
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-a-lisp-for-export-text-to-csv/td-p/9605224
   (defun writeCSV ( csvfile dblist dlm / file_w lines text record val)

      ; function to write .csv file: By Roland.R71
      ; Follows csv standards, as far as there are any.

      ; csvfile = path+filename to use. example: c:\\temp\\mydata.csv
      ; dblist  = a 'database' list of values. (a list of lists)
      ; dlm     = the delimiter to use. example: , ; \t (tab) etc.
      ; Function checks for delimiter inside values, adds quotes if found.
      ;
      ; Example code:
      ; (setq lst (list '("1" "2" "3") '("4" "5,1" "6") '("7" "8.1" "9") '("" "" "")))
      ; (writeCSV "c:/temp/test.csv" lst ",")
      ;
      ; example csv file:
      ; 1,2,3
      ; 4,"5,1",6
      ; 7,8.1,9
      ; ,,

      (setq file_w (open csvfile "w"))
      (foreach record dblist
         (setq i 0 text "")
         (while (< i (length record))
            (setq val  (cond ((nth i record))(""))
                  val  (cond ((vl-string-search dlm val)(strcat "\"" val "\""))(val))
                  text (strcat text val)
                  i    (1+ i)
            )
            (if (< i (length record))
               (setq text (strcat text dlm))
            )
         )
         (write-line text file_w)
      )
      (close file_w)
   )
   

(defun c:DWH ( / ss i ent obj type handle layer color len area closed hyperlink row rows)
	(setq ss (ssget (list (cons 0 "*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS"))))
	(setq i 0)
	(setq rows (list (list 
		"TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"  "AREA"  "LENGTH"
	)))
	(repeat (sslength ss)
	
		(princ "\n")
	
		(setq ent (ssname ss i))
		(setq obj (vlax-ename->vla-object ent))	;; in case we need visual lisp functions
	
	;; These properties exist for every object
		;; type of entity
		(setq type (cdr (assoc 0 (entget ent))))
		;; entity handle
		(setq handle (cdr (assoc 5 (entget ent))))
		;; layer
		(setq layer (cdr (assoc 8 (entget ent))))
		;; color
		
		(if (assoc 420 (entget ent))
			(setq color (cdr (assoc 420 (entget ent))))	;; true color
			(setq color (cdr (assoc 62 (entget ent))))	;; indexed color
		)
		(setq color (if color (rtos color 2 0) " "))
		(princ " ")
		(princ color)
		
		
	;;;;  	properties for some types. and each has a different way of getting it  ;;;;
	
		;; length.  
			;; blocks don't have a length.
			;; regios have a perimeter
			;; circles have a circumference
					;;(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
		(setq len 0)
		(cond
			( 	(= type "CIRCLE")
				(setq len (vla-get-circumference obj))
			)
			( 	(= type "REGION")
				(setq len (vla-get-perimeter obj))
			)
			( 	(= type "SPLINE")
				(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(setq len (vla-get-Length obj))
			)
		)
		
		;; Area.  only closed objects have it.  Not closed splines/polylines don't.
		(setq area 0)
		(cond
			( 	(= type "CIRCLE")
				(setq area (vla-get-area obj))
			)
			( 	(= type "REGION")
				(setq area (vla-get-area obj))
			)
			( 	(= type "SPLINE")
				;; (assoc 70) is even -> not closed.  odd -> closed
				(if (= 1 (rem (cdr (assoc 70 (entget ent))) 2 ))
					(setq area (vla-get-area obj))
				)
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(if (= 1 (cdr (assoc 70 (entget ent))))
					(setq area (vla-get-area obj))
				)
			)
		)
		
		(setq hyperlink "")
		;; Hyperlink
		;; https://www.cadtutor.net/forum/topic/41225-read-and-create-an-hyperlink/
		(vlax-for hyp (vla-get-hyperlinks obj)
			(setq hyperlink (vla-get-url hyp))
		)
		

		;; "TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"   "AREA"  "LENGTH"
		(setq rows (append rows (list (list 
			type 
			handle 
			layer 
			hyperlink 
			color
			(rtos area 2 4) 
			(rtos len 2 4) 	;; CSV export expents strings, not numbers.  feel free to change the number of digits (now 4)
		))))

		
		;;(princ " *** ")
		(setq i (+ i 1))
	)
	;;(princ rows)
	
	;;(writeCSV  csvfile dblist dlm)
	

	(writeCSV  (strcat (getvar "dwgprefix") (getvar "dwgname") ".csv") rows ",")
	(princ (strcat "File saves as: " (getvar "dwgprefix") (getvar "dwgname") ".csv"))

	
	(princ )
)

May 27, 2023

Emmanuel Multi toggles will do the dcl for "please choose". Examples at top of code. Returns a list (0 1 0 1 1 1 0) etc 1 is selected toggle is on.

Multi toggles.lsp

I have sent you PM re send data to excel direct no csv.

Edited May 27, 2023 by BIGAL

May 27, 2023

Quote

Here's part of the request

If somebody wants to handle this dialog part, please do

This just saves the file with the same path and filename as the drawing.

command DWH for Dataextraction With Handle

THANK YOU SO MUCH FOR THIS!

I am completely dumb on this language but truly appreciate the commentary lines (ie. combining perimeter of region under length column).

I made a minor tweaks to match my needs:

• for OBJECT TYPES: added POINT

• for HYPERLINK: used vlax-get-property hyp 'URLDescription

• for COLOR: set "By Layer" if nil

Kind request to adjust these as well:

• for INDEX COLOR: show index number

• for TRUE COLOR: show RGB format (ie. 0,0,255)

• for FILEPATH: save to Downloads Folder (C:\Users\ \Downloads)

• for EXCEL: keep the excel file open after saving

• for BLOCK: instead of displaying 'INSERT' under type column, display the 'BLOCKNAME' instead

Revised Code:

; --- writeCSV ----------------------------------------------------------------
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-a-lisp-for-export-text-to-csv/td-p/9605224
   (defun writeCSV ( csvfile dblist dlm / file_w lines text record val)

      ; function to write .csv file: By Roland.R71
      ; Follows csv standards, as far as there are any.

      ; csvfile = path+filename to use. example: c:\\temp\\mydata.csv
      ; dblist  = a 'database' list of values. (a list of lists)
      ; dlm     = the delimiter to use. example: , ; \t (tab) etc.
      ; Function checks for delimiter inside values, adds quotes if found.
      ;
      ; Example code:
      ; (setq lst (list '("1" "2" "3") '("4" "5,1" "6") '("7" "8.1" "9") '("" "" "")))
      ; (writeCSV "c:/temp/test.csv" lst ",")
      ;
      ; example csv file:
      ; 1,2,3
      ; 4,"5,1",6
      ; 7,8.1,9
      ; ,,

      (setq file_w (open csvfile "w"))
      (foreach record dblist
         (setq i 0 text "")
         (while (< i (length record))
            (setq val  (cond ((nth i record))(""))
                  val  (cond ((vl-string-search dlm val)(strcat "\"" val "\""))(val))
                  text (strcat text val)
                  i    (1+ i)
            )
            (if (< i (length record))
               (setq text (strcat text dlm))
            )
         )
         (write-line text file_w)
      )
      (close file_w)
   )
   

(defun c:DWH ( / ss i ent obj type handle layer color len area closed hyperlink row rows)
	(setq ss (ssget (list (cons 0 "POINT,*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS"))))
	(setq i 0)
	(setq rows (list (list 
		"TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"  "AREA"  "LENGTH"
	)))
	(repeat (sslength ss)
	
		(princ "\n")
	
		(setq ent (ssname ss i))
		(setq obj (vlax-ename->vla-object ent))	;; in case we need visual lisp functions
	
	;; These properties exist for every object
		;; type of entity
		(setq type (cdr (assoc 0 (entget ent))))
		;; entity handle
		(setq handle (cdr (assoc 5 (entget ent))))
		;; layer
		(setq layer (cdr (assoc 8 (entget ent))))
		;; color
		
		(if (assoc 420 (entget ent))
			(setq color (cdr (assoc 420 (entget ent))))	;; true color
			(setq color (cdr (assoc 62 (entget ent))))	;; indexed color
		)
		(setq color (if color (rtos color 2 0) "By Layer"))
		
		
	;;;;  	properties for some types. and each has a different way of getting it  ;;;;
	
		;; length.  
			;; blocks don't have a length.
			;; regios have a perimeter
			;; circles have a circumference
					;;(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
		(setq len 0)
		(cond
			( 	(= type "CIRCLE")
				(setq len (vla-get-circumference obj))
			)
			( 	(= type "REGION")
				(setq len (vla-get-perimeter obj))
			)
			( 	(= type "SPLINE")
				(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(setq len (vla-get-Length obj))
			)
		)
		
		;; Area.  only closed objects have it.  Not closed splines/polylines don't.
		(setq area 0)
		(cond
			( 	(= type "CIRCLE")
				(setq area (vla-get-area obj))
			)
			( 	(= type "REGION")
				(setq area (vla-get-area obj))
			)
			( 	(= type "SPLINE")
				;; (assoc 70) is even -> not closed.  odd -> closed
				(if (= 1 (rem (cdr (assoc 70 (entget ent))) 2 ))
					(setq area (vla-get-area obj))
				)
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(if (= 1 (cdr (assoc 70 (entget ent))))
					(setq area (vla-get-area obj))
				)
			)
		)
		

		;; Hyperlink
		;; https://www.cadtutor.net/forum/topic/41225-read-and-create-an-hyperlink/
		(setq hyperlink "")
		(vlax-for hyp (vla-get-hyperlinks obj)
			(setq hyperlink (vlax-get-property hyp 'URLDescription))
		)
		

		;; "TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"   "AREA"  "LENGTH"
		(setq rows (append rows (list (list 
			type 
			handle 
			layer 
			hyperlink 
			color
			(rtos area 2 4) 
			(rtos len 2 4) 	;; CSV export expents strings, not numbers.  feel free to change the number of digits (now 4)
		))))

		
		;;(princ " *** ")
		(setq i (+ i 1))
	)
	;;(princ rows)
	
	;;(writeCSV  csvfile dblist dlm)
	

	(writeCSV  (strcat (getvar "dwgprefix") (getvar "dwgname") ".csv") rows ",")
	(princ (strcat "File saves as: " (getvar "dwgprefix") (getvar "dwgname") ".csv"))

	
	(princ )
)

Thank you for taking the time to understand and write the code. It is exactly what im looking for.

Hoping this code helps other engineers as well.

Thanks & Regards.

May 30, 2023

This is with most of the added requests


; --- writeCSV ----------------------------------------------------------------
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/need-a-lisp-for-export-text-to-csv/td-p/9605224
   (defun writeCSV ( csvfile dblist dlm / file_w lines text record val)

      ; function to write .csv file: By Roland.R71
      ; Follows csv standards, as far as there are any.

      ; csvfile = path+filename to use. example: c:\\temp\\mydata.csv
      ; dblist  = a 'database' list of values. (a list of lists)
      ; dlm     = the delimiter to use. example: , ; \t (tab) etc.
      ; Function checks for delimiter inside values, adds quotes if found.
      ;
      ; Example code:
      ; (setq lst (list '("1" "2" "3") '("4" "5,1" "6") '("7" "8.1" "9") '("" "" "")))
      ; (writeCSV "c:/temp/test.csv" lst ",")
      ;
      ; example csv file:
      ; 1,2,3
      ; 4,"5,1",6
      ; 7,8.1,9
      ; ,,

      (setq file_w (open csvfile "w"))
      (foreach record dblist
         (setq i 0 text "")
         (while (< i (length record))
            (setq val  (cond ((nth i record))(""))
                  val  (cond ((vl-string-search dlm val)(strcat "\"" val "\""))(val))
                  text (strcat text val)
                  i    (1+ i)
            )
            (if (< i (length record))
               (setq text (strcat text dlm))
            )
         )
         (write-line text file_w)
      )
      (close file_w)
   )
   

;; EXTRA TODO:    
   
;;;; I made a minor tweaks to match my needs:
;;• for OBJECT TYPES: added POINT
;;• for HYPERLINK: used  vlax-get-property hyp 'URLDescription


 

;;• for INDEX COLOR: show index number
;;• for TRUE COLOR: show RGB format (ie. 0,0,255)
;; http://www.lee-mac.com/colourconversion.html#rgbtru

;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)
;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour
(defun LM:True->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)


;; get blockname. 
;; you can get the blockname with (assoc 0 ent), except for dynamic blocks.
;; this function also works for dynamic blocks 
(defun getEffectiveName (ent)
  (vla-get-effectivename (vlax-ename->vla-object ent))
)
 
 
 
 ;; http://www.lee-mac.com/listtostring.html
;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)
   
(defun c:DWH ( / ss i ent obj type handle layer color len area closed hyperlink row rows savepath)
	(setq ss (ssget (list (cons 0 "*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS"))))
	(setq i 0)
	(setq rows (list (list 
		"TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"  "AREA"  "LENGTH"
	)))
	(repeat (sslength ss)
	
		(princ "\n")
	
		(setq ent (ssname ss i))
		(setq obj (vlax-ename->vla-object ent))	;; in case we need visual lisp functions
	
	;; These properties exist for every object
		;; type of entity
		(setq type (cdr (assoc 0 (entget ent))))
		;; entity handle
		(setq handle (cdr (assoc 5 (entget ent))))
		;; layer
		(setq layer (cdr (assoc 8 (entget ent))))
		;; color
		
		;;• for COLOR: set  "By Layer" if nil
		(setq color "ByLayer")		;; default color.  if (assoc 6) or (assoc 420) is found, then we override this 
		(if (assoc 420 (entget ent))
			(progn 
				(setq color (cdr (assoc 420 (entget ent))))	;; true color
				(princ color)
				;; convert to rgb
				(setq color (LM:True->RGB color))
				(setq color (strcat
					(rtos (nth 0 color) 2 0) ","
					(rtos (nth 1 color) 2 0) ","
					(rtos (nth 2 color) 2 0) 
				))
				(princ color)
				 
			)
			(if (assoc 62 (entget ent))
				(progn
					(setq color (rtos (cdr (assoc 62 (entget ent))) 2 0) )	;; indexed color
					(princ color)
					;;(princ (type color))
					;; 
				)
			)
		)

		
		
	;;;;  	properties for some types. and each has a different way of getting it  ;;;;
	
		;; length.  
			;; blocks don't have a length.
			;; regios have a perimeter
			;; circles have a circumference
					;;(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
		(setq len 0)
		(cond
			( 	(= type "CIRCLE")
				(setq len (vla-get-circumference obj))
			)
			( 	(= type "REGION")
				(setq len (vla-get-perimeter obj))
			)
			( 	(= type "SPLINE")
				(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(setq len (vla-get-Length obj))
			)
		)
		
		;; Area.  only closed objects have it.  Not closed splines/polylines don't.
		(setq area 0)
		(cond
			( 	(= type "CIRCLE")
				(setq area (vla-get-area obj))
			)
			( 	(= type "REGION")
				(setq area (vla-get-area obj))
			)
			( 	(= type "SPLINE")
				;; (assoc 70) is even -> not closed.  odd -> closed
				(if (= 1 (rem (cdr (assoc 70 (entget ent))) 2 ))
					(setq area (vla-get-area obj))
				)
			)
			( 	(or (= type "LWPOLYLINE") (= type "POLYLINE"))
				(if (= 1 (cdr (assoc 70 (entget ent))))
					(setq area (vla-get-area obj))
				)
			)
		)
		
		(setq hyperlink "")
		;; Hyperlink
		;; https://www.cadtutor.net/forum/topic/41225-read-and-create-an-hyperlink/
		(vlax-for hyp (vla-get-hyperlinks obj)
			(setq hyperlink (vla-get-url hyp))
		)
		

		;; "TYPE"  "HANDLE"  "LAYER"  "HYPERLINK"  "COLOR"   "AREA"  "LENGTH"
		
		;;• for BLOCK: instead of displaying 'INSERT' under type column, display the 'BLOCKNAME' instead   
		(if (= type "INSERT")
			(setq type (getEffectiveName ent))
			;;(setq type (cdr (assoc 2 (entget ent))))
		)
		
		(setq rows (append rows (list (list 
			type 
			handle 
			layer 
			hyperlink 
			color
			(rtos area 2 4) 
			(rtos len 2 4) 	;; CSV export expents strings, not numbers.  feel free to change the number of digits (now 4)
		))))

		
		(princ " *** ")
		(setq i (+ i 1))
	)
	;;(princ rows)
	
	;;(writeCSV  csvfile dblist dlm)
	

	;;(setq savepath (strcat (getvar "dwgprefix") (getvar "dwgname") ".csv"))
	;;(writeCSV  savepath rows ",")
	;;(princ savepath)
	
	;;• for FILEPATH: save to Downloads Folder (C:\Users\ \Downloads)
	;; Windows user is set in (getvar "loginname")   
	(setq savepath (strcat "C:\\Users\\" (getvar "loginname") "\\Downloads\\" (getvar "dwgname") ".csv"))
	(princ savepath)
	(writeCSV  savepath rows ",")
	
	;;• for EXCEL: keep the excel file open after saving
	;;(setq file (open savepath "w"))
	
	(princ )
)

June 2, 2023

I appreciate all the effort. Thank you Emmanuel.

Attaching the .lsp file to share with others:

(DWH) DataExtraction With Handle

This LISP Function will collect the properties of selected objects and export it as CSV File.

• Command: DWH

• Selection Set: POINT,*POLYLINE,SPLINE,REGION,INSERT,CIRCLE,POLYGONS

• Properties: TYPE, HANDLE, LAYER, HYPERLINK, COLOR, AREA, LENGTH

• File Path: (C:\Users\ \Downloads)

(DWH) Data With Handle.lsp

Sign In

AutoLISP function similar to DataExtraction but with HANDLE

Recommended Posts

Donistco

Emmanuel Delay

Donistco

Emmanuel Delay

BIGAL

Donistco

Emmanuel Delay

Donistco

Join the conversation

Tutorials

Forums

Activity