Thanks to the lisp that outputs coordinates in clusters

[Thang.VD.HD]

Hello everyone.

Please create a lisp with the following functions:

+ Drawing consists of rectangles, in the rectangle there are circles.

+ Scan and select shapes from the drawing. Insert text next to the rectangle with the prefix entered from the keyboard, then the serial number. (See input image)
+ Circles are added with text numbered in ascending order with the rule, type all circles in rectangle 1 then circles in the next rectangle. (See output image 1)
+ Export data to excel file or .txt file with data
1. Rectangle text 2. Serial number of circle in rectangle 3. X coordinate of circle center 4. Y coordinate of circle center. (See output image 2)
Thank you.

Edited December 6 by Thang.VD.HD

[Steven P]

How are your abilities with LISP or programming? If we give you hint of what to do would that be enough for you to make a start?

 

For the circle numbers, what is the logic behind their numbering in each rectangle?

Rectangles - I assume are closed polylines, but will the drawing have any other 4 sided closed polylines that are not to be assessed?

Perhaps upload a sample drawing if you can?

 

How often will you be doing this? (daily, weekly, monthly, once a year)

 

 

If it was me I'd go back a few steps and have the user to select the circles in the order they want them numbered and put in the text from there - much easier to program

[BIGAL]

Maybe something like this as a starting point.Multi GETVALS.lsp save Multi getvals in a support path as its auto loaded.

 

; 4 holes in rectang 
; By AlanH Feb 2022 
; Modified for row and columns July 2024


 (defun c:recholes ( /  oldsnap obj ss len ht ans voff hoff rad  rows cols )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))

(setq ans (AH:getvalsm (list "Enter values" "length" 5 4 "20" "height" 5 4 "10" "vertical offset" 5 4 "1.5" 
"Horizontal offset" 5 4 "2.5" "Radius" 5 4 "0.25" "Hor columns" 5 4 "4" "Ver rows" 5 4 "3" "Angle " 5 4 "0.0")))

(setq len (atof (nth 0 ans))
ht (atof (nth 1 ans))
voff (atof (nth 2 ans))
hoff (atof (nth 3 ans))
rad (atof (nth 4 ans))
cols (atoi (nth 5 ans))
rows (atoi (nth 6 ans))
ang (atof (nth 7 ans))
)

(setq pt (getpoint "\nPick lower left point"))
(command "Rectang" pt (mapcar '+ pt (list len ht 0.0)))
(setq rent (entlast))

(setq ss (ssadd))
(setq pt1 (mapcar '+ pt (list hoff voff 0.0)))
(command "circle" pt1 rad)
(setq ss (ssadd (entlast) ss))

(setq pt3  pt1)
(setq d1 (/ (- len (* 2.0 hoff))(- cols 1)))
(repeat (- cols 1)
(setq pt2 (mapcar '+ pt3 (list d1 0.0 0.0)))
(command "circle" pt2 rad)
(setq pt3 pt2)
(setq ss (ssadd (entlast) ss))
)

(setq d2 (/ (- ht (* 2.0 voff))(- rows 1)))
(setq x 1.0)
(repeat (- rows 1)
(setq pt2 (mapcar '+ pt1 (list 0.0 (* x d2) 0.0)))
(command "copy" ss "" pt1 pt2)
(setq x (1+ x))
)

; top dims

(setq pt1 (mapcar '+ pt (list 0.0 ht 0.0)))
(setq pt2 (mapcar '+ pt (list len ht 0.0)))
(setq pt3 (mapcar '+ pt1 (list 0.0 5.0 0.0)))
(command "dim" "Hor" pt1 pt2 pt3 "" "exit")

(setq pt2 (mapcar '+ pt1 (list hoff (- voff) 0.0)))
(setq pt3 (mapcar '+ pt1 (list 0.0 2.5 0.0)))
(command "dim" "Hor" pt1 pt2 pt3 "" "exit")

(repeat (- cols 1)
  (setq pt1 pt2)
  (setq pt2 (mapcar '+ pt1 (list d1 0.0 0.0)))
  (command "dim" "Hor" pt1 pt2 pt3 "" "exit")
)

(setq pt1 pt2)
(setq pt2 (mapcar '+ pt1 (list hoff 0.0 0.0)))
(command "dim" "Hor" pt1 pt2 pt3 "" "exit")

;left dims
(setq pt2 (mapcar '+ pt (list 0.0 ht 0.0)))
(setq pt3 (mapcar '+ pt (list (- 5) 0.0 0.0)))
(command "dim" "Ver" pt pt2 pt3 "" "exit")

(setq pt2 (mapcar '+ pt (list hoff voff 0.0)))
(setq pt3 (mapcar '+ pt (list (- 2.5) 0.0 0.0)))
(command "dim" "Ver" pt pt2 pt3 "" "exit")


(repeat (- rows 1)
  (setq pt1 pt2)
  (setq pt2 (mapcar '+ pt1 (list 0.0 d2 0.0)))
  (command "dim" "Ver" pt1 pt2 pt3 "" "exit")
)

(setq pt1 pt2)
(setq pt2 (mapcar '+ pt1 (list 0.0 voff 0.0)))
(command "dim" "Ver" pt1 pt2 pt3 "" "exit")



(if (= ang 0.0)
(princ)
(progn
(setq ss (ssget "CP" (list pt (mapcar '+ pt (list len ht 0.0)))))
(setvar 'aunits 1)
(command "rotate" ss "" pt ang)
)
)

(setvar 'osmode oldsnap)
(princ)

)
(c:recholes)

[Thang.VD.HD]

@Steven PI am a newbie, don't know much about Autolisp.
If possible, please give me instructions to start.
+ The circles are numbered in ascending order, can be from left to right or from top to bottom. (or maybe not). Just the circle number is numbered in ascending order and continues with the next rectangle.
+ There is only 1 rectangle with no shapes inside or outside. The shape is a polyline
+ I have to do this every week, with a frequency of 10 times / weekanchor bolt plan.dwg
+ The number of circles and squares is very large, if I scan through each shape, it will take time

[Thang.VD.HD]

@BIGAL Thank you very much. But this is not the lisp I want.
I have the data is bolt positioning. What I need to do is number it to identify, then export the bolt center coordinate data to txt or excel file.
Anyway thank you.

[BIGAL]

Try this 

(defun lotsofholes ( / )
(setq pi45 (* pi 0.25))
(setvar 'textstyle "Standard")
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 512)
(setq pt (getpoint "\nPick bottom left corner "))
(command "UCS" "OB" pt)
(command "PLan" "")
(command "zoom""C" (trans pt 0 1) 6.0)
(prompt "select all circles use window enter  to stop ")
(while (setq ss (ssget '((0 . "Circle"))))
(if (= ss nil)(progn (Alert "no circles found \nwill now exit ")(exit)))
(setq cnum (vlax-ldata-get "Circles" "NUM"))
(if (= cnum nil) (setq cnum 0))
(setq lst '())
(setq x -1)
(repeat (sslength ss)
  (setq ent (entget (ssname ss (setq x (1+ x)))))
  (setq rad (cdr (assoc 40 ent)))
  (setq cen (cdr (assoc 10 ent)))
  (setq cenucs (trans (cdr (assoc 10 ent)) 0 1))
  (setq cx (atof (rtos (car cenucs) 2 4) ) cy (atof (rtos (cadr cenucs) 2 4)))
  (setq lst (cons (list cx cy (car cen)(cadr cen) rad) lst))
)
(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) 
		  (< (cadr a) (cadr b)))
	    )
	  )
)
)
(setvar 'osmode 0)
(foreach val lst
(setq cen (list (car val)(cadr val)))
(setq rad (nth 4 val))
(command "text" (polar cen pi45 (+ rad (* rad 0.2))) rad 0.0 (rtos (setq cnum (1+ cnum)) 2 0))
)
(vlax-ldata-put "Circles" "NUM" cnum))
(setvar 'osmode 512)
(command "ucs" "w")
(command "plan" "")
(princ)
)
(lotsofholes)

Pick lower left when asked. Used to get orientation, last number is saved in dwg.

 

In the "LST" is the co-ordinates of the circles. A question the example dwg does not look like a real size was this done just for get code ? How is the co-ords relevant to what ? Does not look like 0,0 etc.

Edited December 8 by BIGAL

[Thang.VD.HD]

@BIGAL Thanks. 
The numbering of the circles is exactly what I had in mind.
The coordinates of the center of the circle will be the coordinates relative to the origin 0,0 of the drawing.
I need to name the rectangles to determine which rectangle the circles are in.
Then export the coordinates of the centers of the circles to a .txt file as shown below.
Thank you very much.

[BIGAL]

Ok understand, a different approach get all the rectangs in an order, have a way to do that. Can send direct to Excel, no need to make a text file. Please confirm want an Excel as end result. It on my "to do list".

[Thang.VD.HD]

@BIGALThank you very much. This is the resulting excel file that I want.
It includes 4 columns.
Column 1 is the name of the rectangle / Column 2 is the circle number (inside the rectangle) / X coordinate of the center of the circle / Y coordinate of the center of the circle (coordinates relative to the origin 0,0. Take the decimal part of 3 numbers) 

anchor_bolt.xlsx

[BIGAL]

I understand just have to have time to do something. I have to change the code to recognise the plines and look inside for circles this way the rectangs will be labelled in sequence.

[Thang.VD.HD]

@BIGAL Thank you, looking forward to the completed lisp.

[Thang.VD.HD]

Hi @BIGAL I look forward to hearing from you.

[BIGAL]

Have not forgotten may have time today.

[BIGAL]

This is an update still a few bugs but sorts the rectangs now when selecting all. Missing llabelling 1st box not sure why not.

 

Once current bugs fixed will do the out to Excel that is the easy bit.

; https://www.cadtutor.net/forum/topic/94594-thanks-to-the-lisp-that-outputs-coordinates-in-clusters/
; BY AlanH Dec 2024

(defun lotsofholes ( / box cnum co-ord co-ords ent entn lst lst2 lst3 oldsnap pi45 pre pt rad ss vla xlsetcelltext)
;;	Thanks to fixo			;;
;;   = Set Excel cell text =    ;;
;;				;;
(defun xlsetcelltext ( row column text)
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	(vlax-make-variant (vl-princ-to-string text) vlax-vbstring)))
)

(setq pi45 (* pi 0.25))
(setvar 'textstyle "Standard")
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 512)
(setq box 0)
(setq lst3 '())

(setq pre (getstring "\nEnter prefix B etc "))

(setq pt (getpoint "\nPick bottom left corner "))

(command "UCS" "OB" pt)
(command "PLan" "")
(command "zoom""C" (trans pt 0 1) 6.0)
(prompt "select all rectangs use window enter to stop ")

(setq ss (ssget '((0 . "LWPOLYLINE"))))

(if (= ss nil)(progn (Alert "no rectangs found \nwill now exit ")(exit)))

(setq cnum (vlax-ldata-get "Circles" "NUM"))
(if (= cnum nil) (setq cnum 0))
(setq co-ords '())

; sort rectangs re order here so remake ss
(repeat (setq x (sslength ss))
  (setq entn (ssname ss (setq x (1- x))))
  (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (a) (= (car a) 10)) (entget entn))))
  (setq co-ords (cons  (list (car (car co-ord)) (cadr (car co-ord)) entn) co-ords))
)
(setq co-ords (vl-sort co-ords
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) 
		  (< (cadr a) (cadr b)))
	    )
	  )
    )
)

(foreach val co-ords
  (setq lst2 '())
  (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (a) (= (car a) 10)) (entget (caddr val)))))
  (setq co-ord (cons (last co-ord) co-ord))
  (setvar 'osmode 0)
  (foreach pt co-ord
   (setq lst2 (cons (trans pt 0 1) lst2))
  )
  (command "text" (cadr lst2) rad (* 0.25 pi) (strcat pre (rtos (setq box (1+ box)) 2 0)))
  (setq ss2 (ssget "_CP" lst2 (list (cons 0 "CIRCLE"))))
  (setq lst '())
  (repeat (setq K (sslength ss2))
   (setq ent (entget (ssname ss2 (setq k (1- k)))))
   (setq rad (cdr (assoc 40 ent)))
   (setq cen (cdr (assoc 10 ent)))
   (setq cenucs (trans (cdr (assoc 10 ent)) 0 1))
   (setq cx (atof (rtos (car cenucs) 2 4)) cy (atof (rtos (cadr cenucs) 2 4)))
   (setq lst (cons (list cx cy rad) lst))
  )
  (setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) 
		  (< (cadr a) (cadr b)))
	    )
	  )
    )
  )
(foreach val lst
   (setq cen (list (car val)(cadr val)))
   (setq rad (caddr val))
   (setq str (rtos (setq cnum (1+ cnum)) 2 0))
   (command "text" (polar cen pi45 (+ rad (* rad 0.2))) rad 0.0 str)
   (setq lst3 (cons (list (strcat pre (rtos box 2 0)) (strcat str) (trans cen 1 0)  rad ) lst3))
)
(vlax-ldata-put "Circles" "NUM" cnum)
)
(setvar 'osmode 512)
(command "ucs" "w")
(command "plan" "")

; now do excel lst3
(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; opens a new xl

(setq row 1)
(setq lst3 (reverse lst3))
(foreach val lst3
(xlsetcelltext row 1 (nth 0 val))
(xlsetcelltext row 2 (nth 1 val))
(xlsetcelltext row 3 (car (nth 2 val)))
(xlsetcelltext row 4 (cadr (nth 2 val)))
(setq row (1+ row))
)

(princ)
)
(lotsofholes)

 

Edited December 18 by BIGAL

[Thang.VD.HD]

Thanks brother @BIGAL. Filling in the order number for the circle is ok. But I need more than exporting the coordinates of the circle corresponding to the rectangle to an excel file. I'm sure you are very busy. But please help me because it helps me a lot. Thank you.

[BIGAL]

Code above updated, do not have Excel open as code will open Excel. It is still under development but post any comments.

 

 

Edited December 17 by BIGAL

[Thang.VD.HD]

7 hours ago, BIGAL said:

Code above updated, do not have Excel open as code will open Excel. It is still under development but post any comments.

 

 

Thanks bro. The excel file has been exported. But the coordinates are incorrect.
Currently the exported coordinates are the coordinates after changing the UCS coordinate axis, not the coordinates compared to the origin 0,0 of the original drawing.

[Thang.VD.HD]

11 hours ago, BIGAL said:

Code above updated, do not have Excel open as code will open Excel. It is still under development but post any comments.

 

 

1. Duplicate - a rectangle is scanned twice
2. The coordinates of the circle relative to the 0,0 coordinates of the drawing are incorrect.

I hope you can fix this error soon.
Thank you.

[BIGAL]

Ok will look into why X&Y are wrong.

 

The duplicate did you run the code twice or pick the rectang twice ?

[Thang.VD.HD]

3 hours ago, BIGAL said:

Ok will look into why X&Y are wrong.

 

The duplicate did you run the code twice or pick the rectang twice ?

sorry, my file has duplicate rectangle.
please help me check the X,Y coordinates.
thank you very much.