https://www.youtube.com/watch?v=lus7WLJ2wJQ&feature=youtu.be
It numbers rectangles and then lists their coordintes in a comma delimited file, ie .csv
;Program written by Bill Le Couteur
;Auckland NZ
;Rev 0 date 29/11/17
;This program selects rectangles and labels them with coordinates,length, width and area
;
;
(defun c:LR()
;(setvar "CMDECHO" 0)
(setq oldsnapmode (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "w")
(setq the_count "500"); just a dummy so the while loop keeps going unless user escapes!
(setq count 0)
(setq SerialNo 1)
(setq SerialNos (itoa SerialNo))
(setq the_drg_path (getvar "DWGPREFIX"))
(setq the_file_name (getstring "/nEnter the file name, no prefixes or suffixes: "))
(setq the_text_height (getreal "/nEnter the text height needed: "))
(setq full_file_name (strcat the_drg_path the_file_name ".csv"))
;this makes sure the file is empty if first used!
(if (not(equal beenthere T))
(close (open full_file_name "w"))
)
;;;;;;;;;;;;;;;;;;WHILE LOOP TO GO PICK RECTANGLES ONE BY ONE;;;;;;;;;;;;
(while (not(equal the_count "1000"))
(progn
(prompt "/npick the rectangle")
(setq edata(entget(car(entsel)))) ;getting the pline's data
(setq ename (cdr(assoc -1 edata)))
(setq the_item (cdr (assoc 0 edata))) ;IF THE USER PICKS A CIRCLE, IT IS A SIGN TO STOP NOW, IE CLOSE THE FILE
;(if (eq "CIRCLE" the_item)
; (progn
; (print "now closing")
; (close fp)
; (exit)
; )progn
;);end if
(print edata)
;you can see the points in the edata list- they are the dotted pairs that start with 10.
(foreach thing edata
(progn
(if(eq (car thing) 10 ); -ie only interested in the points
(progn;if progn
(print thing)
(if (eq count 0)(setq the_point0 thing))
(if (eq count 1)(setq the_point1 thing))
(if (eq count 2)(setq the_point2 thing))
(if (eq count 3)(setq the_point3 thing))
(setq count (+ count 1))
);end progn
);end if
);end foreach progn
);end foreach
(setq xvalue1 (nth 1 the_point0))
(setq xvalue1s (rtos xvalue1 2 4))
(setq yvalue1 (nth 2 the_point0))
(setq yvalue1s (rtos yvalue1 2 4))
(setq coordsA (strcat xvalue1s "," yvalue1s))
(setq xvalue2 (nth 1 the_point1))
(setq xvalue2s (rtos xvalue2 2 4))
(setq yvalue2 (nth 2 the_point1))
(setq yvalue2s (rtos yvalue2 2 4))
(setq coordsB (strcat xvalue2s "," yvalue2s))
(setq xvalue3 (nth 1 the_point2))
(setq xvalue3s (rtos xvalue3 2 4))
(setq yvalue3 (nth 2 the_point2))
(setq yvalue3s (rtos yvalue3 2 4))
(setq coordsC (strcat xvalue3s "," yvalue3s))
(setq xvalue4 (nth 1 the_point3))
(setq xvalue4s (rtos xvalue4 2 4))
(setq yvalue4 (nth 2 the_point3))
(setq yvalue4s (rtos yvalue4 2 4))
(setq coordsD (strcat xvalue4s "," yvalue4s))
(setq header_line "Sn,Ax,Ay,Bx,By,Cx,Cy,Dx,Dy,Length,Area")
(setq the_length (- xvalue2 xvalue1))
;;;;;;;;;FOR A NORMAL RECTANGLE;;;;;;;;;;;;;;;;;;;;
(if (> the_length 0)
(progn
(setq the_lengths (rtos the_length 2 4))
(setq the_width (- yvalue3 yvalue1))
(setq insert_pointx (+ xvalue1 (/ the_length 2)))
(setq insert_pointy (+ yvalue1 (/ the_width 2)))
(setq insert_point (list insert_pointx insert_pointy))
);end if progn
);end if
;;;;;;;;END OF FOR A NORMAL RECTANGLE;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;FOR A REVERSE RECTANGLE;;;;;;;;;;;;;;;;;;;;
(if (< the_length 0)
(progn
(print "hello")
(setq the_length (* the_length -1))
(setq the_lengths (rtos the_length 2 4))
(setq the_width (- yvalue3 yvalue1))
(setq insert_pointx (- xvalue1 (/ the_length 2)))
(setq insert_pointy (+ yvalue1 (/ the_width 2)))
(setq insert_point (list insert_pointx insert_pointy))
);end if progn
);end if
;;;;;;;;END OF FOR A REVERSE RECTANGLE;;;;;;;;;;;;;;;;;;;;
(if (< the_width 0)(setq the_width (* the_width -1)))
(setq the_area (* the_length the_width))
(setq the_areas (rtos the_area))
(setq the_line (strcat SerialNos "," CoordsA "," CoordsB "," CoordsC "," CoordsD "," the_lengths "," the_areas))
(setq the_text_height 300)
(setq fp (open full_file_name "a"))
(if (not(equal beenthere2 T)) (write-line header_line fp))
(write-line the_line fp)
(command "text" "j" "m" insert_point the_text_height 0 SerialNos)
(setq SerialNo (+ SerialNo 1))
(setq SerialNos (itoa SerialNo))
(setq beenthere2 T)
(setq count 0)
);END OF WHILE PROGN
);END OF WHILE
;;;;;;;;;;;;;;;;;;END OF WHILE LOOP TO GO PICK RECTANGLES ONE BY ONE;;;;;;;;;;;;
(close fp)
(setq beenthere T)
(command "ucs" "w")
;(setvar "CMDECHO" 1)
(setvar "osmode" oldsnapmode)
(princ)
)
