Thanks to the lisp that outputs coordinates in clusters

December 18

Ok found the X&Y problem just change this in line 101 (trans cen 1 0) the trans was the other way around need 1 0.

(setq lst3 (cons (list (strcat pre (rtos box 2 0)) (strcat str) (trans cen 1 0)  rad ) lst3))

Edited December 18 by BIGAL

December 19

On 18/12/2024 at 10:37, BIGAL said:
Ok found the X&Y problem just change this in line 101 (trans cen 1 0) the trans was the other way around need 1 0.
(setq lst3 (cons (list (strcat pre (rtos box 2 0)) (strcat str) (trans cen 1 0)  rad ) lst3))

thanks bro. It worked for the numbers in the coordinates. However the numbers are not correct for the decimal point position.

December 19

I have checked the code, reposted above please copy the code and save again.

CAD

Center point: X= -884.6503 Y= 62.3510 Z= 0.0000

Center point: X= -885.7833 Y= 64.2701 Z= 0.0000

Latest version

; By Alan H DEc 2024
; Gets co-ords of circles in a rectangs

(defun lotsofholes ( / box cnum co-ord co-ords ent entn lst lst2 lst3 oldsnap pi45 pre pt rad ss vla xlsetcelltext)

(defun find-max-point (points / max-point)
(setq max-point (car points))
(foreach pt (cdr points)
(setq max-point (list (max (car max-point) (car pt))
(max (cadr max-point) (cadr pt))
)
) 
) max-point
)


;;	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))
  )
  (setq maxpt (find-max-point lst2))
  (command "text" maxpt 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 19 by BIGAL

December 20

1 hour ago, BIGAL said:

I have checked the code, reposted above please copy the code and save again.

CAD

Center point: X= -884.6503 Y= 62.3510 Z= 0.0000

Center point: X= -885.7833 Y= 64.2701 Z= 0.0000

Latest version

; By Alan H DEc 2024
; Gets co-ords of circles in a rectangs

(defun lotsofholes ( / box cnum co-ord co-ords ent entn lst lst2 lst3 oldsnap pi45 pre pt rad ss vla xlsetcelltext)

(defun find-max-point (points / max-point)
(setq max-point (car points))
(foreach pt (cdr points)
(setq max-point (list (max (car max-point) (car pt))
(max (cadr max-point) (cadr pt))
)
) 
) max-point
)


;;	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))
  )
  (setq maxpt (find-max-point lst2))
  (command "text" maxpt 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)

CAN YOU SEND ME THE CAD FILE AND THE EXCEL FILE AFTER RUNNING THE LISP. BECAUSE I STILL HAVE AN ERROR RELATED TO THE DECIMAL POINT WHEN I RUN THE FILE.
AND MY FILE RUN LISP

anchor bolt plan.dwg HOLE2.xlsx

December 20

I don't understand this is what I got. It appears to be correct. It matches the co-ordinates you have.

anchor bolt plan (1).dwg Anchor bolts copy.xlsx

December 20

3 hours ago, BIGAL said:

I don't understand this is what I got. It appears to be correct. It matches the co-ordinates you have.

anchor bolt plan (1).dwg 2.46 MB · 0 downloads Anchor bolts copy.xlsx 43.19 kB · 0 downloads

Thanks brother. I found the error: The error is because the Windows operating system installed on the computer is using a comma ( , ) as a decimal point, while CAD uses a dot ( . ). Therefore, when converting coordinates between the current UCS coordinate system and 0,0, an error occurred.
Do you have a way to fix this error, because by default I have to use a comma ( , ) as a decimal point.

There is one problem that when used multiple times, the circle order number does not reset to 1. I want to be able to set the starting order number of the rectangle and circle by entering from the keyboard.

Thank you very much brother.

Edited December 20 by Thang.VD.HD

December 20

There is a SysVars for changing decimal separator for Dimensions. DIMDSEP and DIMLUNIT = 2 (Decimal) or it is disabled. But, I believe it's just an override, not sure though.

AutoCAD 2022 Help | DIMDSEP (System Variable) | Autodesk

Maybe read this...

Identify decimal separator via autolisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums

December 20

2 hours ago, SLW210 said:

There is a SysVars for changing decimal separator for Dimensions. DIMDSEP and DIMLUNIT = 2 (Decimal) or it is disabled. But, I believe it's just an override, not sure though.

AutoCAD 2022 Help | DIMDSEP (System Variable) | Autodesk

Maybe read this...

Identify decimal separator via autolisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums

Thanks @SLW210 . I tried the DIMDSEP command but the result is the same.

December 20

Like stated, for dimensions only.

Did you read the thread I linked?

December 20

What happens if you format the X&Y columns as numbers will that auto change to comma ? I understand Excel uses comma in some versions.

In these 2 lines are the send to Excel could change to strings so the period would be replaced with a comma.

(xlsetcelltext row 3 (car (nth 2 val)))
(xlsetcelltext row 4 (cadr (nth 2 val)))

Please try the format 1st.

December 21

8 hours ago, SLW210 said:

Like stated, for dimensions only.

Did you read the thread I linked?

I have read but don't know much about coding. so I don't understand much.

Sign In

Thanks to the lisp that outputs coordinates in clusters

Recommended Posts

BIGAL

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Steven P

BIGAL

BIGAL

Posted Images

Thang.VD.HD

BIGAL

Thang.VD.HD

BIGAL

Thang.VD.HD

SLW210

Thang.VD.HD

SLW210

BIGAL

Thang.VD.HD

Join the conversation

Steven P

BIGAL

BIGAL

Tutorials

Forums

Activity