Count circles within a rectangle

[Juergen]

Hi users,

 

the code underneath helps me a lot.

 

But, how can i get only the number of the circles

from within a rectangle?

The result should be write as text into the drawing.

 

Thx for your help.

 

;Polyline/circle select - www.cadstudio.cz - www.cadforum.cz
;(use the WPS command or 'WPS inside an object selection prompt)

(defun C:WPS ( / i elist at cmde cen rad p1 impl)
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq i 0 elist (entget (car (entsel "\nPick a bounding circle or polyline: ")))) 
(setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384))
(if (zerop (getvar "CMDACTIVE")) (progn (setq impl T)(command "_select")))
(command "_wp") ; or _CP
(if (= (cdr(assoc 0 elist)) "CIRCLE")
 (progn
 (setq cen (cdr (assoc 10 elist))
       rad (cdr (assoc 40 elist)) 
 )
 (repeat 90 ; 360/4  0.06981317=4*pi/180
  (setq p1 (polar cen (* i 0.06981317) rad)  i (1+ i))
;   (command "_POINT" (trans p1 0 1))
  (command (trans p1 0 1))
 )); else
 (repeat (length elist) 
  (setq at (nth i elist) i (1+ i))
;   (if (= (car at) 10) (command (cdr at)))
  (if (= (car at) 10) (command (trans (cdr at) 0 1)))
 )
);if CIRCLE
(command "")
(setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384))
(setvar "cmdecho" cmde)
(if impl (progn (command "")(sssetfirst nil (ssget "_P"))))
(princ)
)

[Tharwat]

Hi,

Something like this?

(defun c:Test (/ s d i p l r g o v c n)
;; Tharwat - 11.Apr.2018     ;;
 (if (and (setq s (car (entsel "\nPick a bounding circle or polyline: ")))
          (or (wcmatch (cdr (assoc 0 (entget s))) "CIRCLE,LWPOLYLINE")
              (alert "Invalid object!. Try again.")
          )
          (setq d (vlax-curve-getdistatparam s (vlax-curve-getendparam s))
                i (/ d 200.0)
                v i
          )
     )
   (progn
     (repeat 200
       (setq p (vlax-curve-getpointatdist s v)
             v (+ v i)
             g (cons p g)
       )
     )
     (vla-getboundingbox (vlax-ename->vla-object s) 'l 'r)
     (vla-zoomwindow (setq o (vlax-get-acad-object)) l r)
     (if (setq c (ssget "_WP" g '((0 . "CIRCLE"))))
       (setq n (sslength c))
     )
     (vla-zoomprevious o)
   )
 )
 (and n
      (setq p (getpoint "\nSpecify text location : "))
      (entmake (list '(0 . "TEXT")
                     (cons 10 p)
                     (cons 11 p)
                     (cons 40 (getvar 'textsize))
                     (cons 1 (itoa n))
               )
      )
 )
 (princ)
) (vl-load-com)

[rlx]

I first scratched my , euh , euh , head when I read the title , select circles in a square...duh... ssget window ;-)

 

but ... bee-you-tea-fool coded Tharwat

[Tharwat]

but ... bee-you-tea-fool coded Tharwat

What's that expression?

[rlx]

What's that expression?

 

just a little word game : beautifull (briliant , elegant , you pick one)

 

[Tharwat]

just a little word game : beautifull (briliant , elegant , you pick one)

 

 

Aha. Thank you.

[Juergen]

Hello Tharwat,

 

That's exactly what I need.

Thank you for your help and that you

took your time.

[Tharwat]

Hello Tharwat,

 

That's exactly what I need.

Thank you for your help and that you

took your time.

 

You are welcome anytime.

[BIGAL]

Tharwat another little saying, cheap, accurate, quick you can only pick one for this project !

 

Lots of variations on this theme.

[Tharwat]

Thanks BIGAL.

 

What are the variations that you would like to add?

[BIGAL]

Couple of weeks ok

next week 1 slab of beer

tomorrow 2 slabs of beer

 

The classic answer

Edited April 13, 2018 by BIGAL

[vudungcom]

On 4/11/2018 at 11:28 PM, Tharwat said:

Hi,

Something like this?

 

(defun c:Test (/ s d i p l r g o v c n)
;; Tharwat - 11.Apr.2018     ;;
 (if (and (setq s (car (entsel "\nPick a bounding circle or polyline: ")))
          (or (wcmatch (cdr (assoc 0 (entget s))) "CIRCLE,LWPOLYLINE")
              (alert "Invalid object!. Try again.")
          )
          (setq d (vlax-curve-getdistatparam s (vlax-curve-getendparam s))
                i (/ d 200.0)
                v i
          )
     )
   (progn
     (repeat 200
       (setq p (vlax-curve-getpointatdist s v)
             v (+ v i)
             g (cons p g)
       )
     )
     (vla-getboundingbox (vlax-ename->vla-object s) 'l 'r)
     (vla-zoomwindow (setq o (vlax-get-acad-object)) l r)
     (if (setq c (ssget "_WP" g '((0 . "CIRCLE"))))
       (setq n (sslength c))
     )
     (vla-zoomprevious o)
   )
 )
 (and n
      (setq p (getpoint "\nSpecify text location : "))
      (entmake (list '(0 . "TEXT")
                     (cons 10 p)
                     (cons 11 p)
                     (cons 40 (getvar 'textsize))
                     (cons 1 (itoa n))
               )
      )
 )
 (princ)
) (vl-load-com)

 

 

Could you add a function that count circle and classify them then write as text in drawing like this:

Thank you

 

[BIGAL]

The 1st part has been answered by Tharwat get a selection set of circles.

 

Loop through the selection set and make a new list of radius's.

Vl-sort the new list

Loop through the new list counting the same radius value put value in a Table.

 

Here is sample code for making a table.

Make table.lsp

[BIGAL]

Found some time try this

 

; count circles in pline 
; by Alanh Sep 2020

(defun c:circpl ( / num x lst tot numrows)

(defun ahmaketable (/ colwidth numcolumns rowheight sp vgms)
(vl-load-com)
(setq sp (vlax-3d-point (getpoint "pick a point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ;
(setq numrows 2)
(setq numcolumns 3)
(setq rowheight 2.5)
(setq colwidth 60)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Circle count"); TABLE TITLE
(vla-settext objtable 1 0 "NO."); TABLE TITLE
(vla-settext objtable 1 1 "Diameter") 
(vla-settext objtable 1 2 "Count")
(command "_zoom" "e")
(princ)
)

(defun ah:addrow ( /  )
(vla-InsertRows objtable (+ numrows 1) (vla-GetRowHeight objtable (- numrows 1)) 1)
(vla-settext objtable numrows 0 (rtos num 2 0))
(vla-settext objtable numrows 1 (rtos n1 2 2)) ;1st column is zero
(vla-settext objtable numrows 2 (rtos tot 2 0))
(setq numrows (+ numrows 1))
(setq num (+ num 1))
(setq tot 0)
)


(while (setq ent (entsel "\npick boundry pline"))
  (if (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
    (progn
    (ahmaketable)
    (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
    (setq ss (ssget "_WP" co-ord '(( 0 . "CIRCLE"))))
    (setq lst '())
    (repeat (setq x (sslength ss))
      (setq lst (append lst (list (cdr (assoc 40 (entget (ssname ss (setq x (- x 1)))))))))
    )
    (setq lst (mapcar 'cdr (vl-sort (mapcar '(lambda (k) (cons 1 k)) lst) '(lambda (y z) (< (cdr y) (cdr z))))))
    (setq num 1 tot 0 x 0)
    (repeat (- (length lst)1)
      (setq n1 (nth x lst) n2 (nth (setq x (+ x 1)) lst))
      (if (= n1 n2)
        (setq tot (+ tot 1))
        (progn
        (setq tot (+ tot 1))
        (ah:addrow)
        )
      )
    )
    (setq tot (+ tot 1))
    (setq n1 n2)
    (ah:addrow)
    )
  )
)

(princ)
)

(c:circpl)