Get Coordinates of center of geometry of selected rectangles to csv

[hythamthelove]

Hello everyone,

I have a lisp (attached) that get dimensions of selected rectangles to csv file, i just want to add a feature to it, i want to get the coordinates of the center of geometry of the rectangle, each coordinate in separate column (as attached photo). There is an attached drawing can help you to understand the case.

Thanks in advance

[hak_vz · Accepted solution]

Try this

Pick rectangles in order you want them in exit CSV. In case you don't select an entity function asks you to make new selection. To exit function hit <enter>.

(defun c:rectCenterToCSV ( / *error* pick_poly take pointlist2d del f file1 eo pts)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(close file1)
		(princ)
	)
	(defun pick_poly (msg / e)
		(setq e (car(entsel msg)))
		(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly msg) e)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
	(setq del (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
	(setq f (getfiled "Output file:" (getvar "dwgprefix") "csv" 3))
	(cond 
		((and f)
			(setq file1 (open f "w"))
			(while (setq eo (vlax-ename->vla-object(pick_poly "\nSelect rectangle >")))
				(setq pts (pointlist2d(vlax-get eo 'Coordinates)))
				(write-line 
					(strcat 
						(rtos (/ (apply '+ (mapcar 'car pts))(length pts)) 2 2)
						del 
						(rtos (/ (apply '+ (mapcar 'cadr pts))(length pts)) 2 2)
					)	
					file1
				)
			)
			(close file1)
		)
		(T (princ "\nOutput file not selected!"))
	)
	(princ)
)

[devitg · Accepted solution]

@hythamthelove , se as attached , need to arrange the header line 

(setq coords (getcoords (ssname ss (setq i (1- i)))))
           (setq dis (mapcar 'distance coords (cdr coords)))
           (setq wid (apply 'min dis))
           (setq len (apply 'max dis))
           ; my adds 
           (SETQ MID-PT-xy (MAPCAR '* '(0.5 0.5 1) (MAPCAR '+ (nth 0 coords) (nth 2 coords))))
           (setq MID-PT-x (nth 0 MID-PT-xy))
           (setq MID-PT-y (nth 1 MID-PT-xy))
           ;end my adds 

, I always use one SETQ for each variable 

  ;add mid x and mid y
(setq csv (cons (strcat (lst->str (mapcar 'rtos (list len wid MID-PT-x MID-PT-y)) del)
del
txtcont
) ;_ strcat
csv
) ;_ cons
) ;_ setq

[hythamthelove]

Thank you so much for your effort

[hythamthelove]

Thank you so much, it was really helping