Jump to content

Recommended Posts

Posted (edited)

 It is necessary to place circles with a radius of 25.0 mm in a checkerboard pattern in a closed outline and paste the 
number of circles in text in the drawing.  The code is not working properly. Draws only one circle???

How can this be fixed?

(defun c:Circles_Chess_outl (/ oddp ent step radius vlist minx miny maxx maxy x y row pt)
  ;;-----------------------------------------------
  ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
  ;;-----------------------------------------------
  (defun oddp (n)
    (= (logand (fix n) 1) 1)
  )

  ;;-----------------------------------------------
  ;; Local auxiliary functions
  ;;-----------------------------------------------

  ;; Extracting a list of vertices (points) of a linear 2D polyline:
  (defun getPolyVertices (e / ed lst pts)
    (setq ed  (entget e)
          ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
          lst (vl-remove-if-not
                '(lambda (x) (= (car x) 10))
                ed
              )
          ;; turning them into a regular list of points (x y)
          pts (mapcar 'cdr lst)
    )
    pts
  )

  ;; Checking whether the pt point is located inside the linear polygon v list:
  (defun pointInPolygon (pt vlist / cnt i v1 v2)
    (setq cnt 0
          i   0
    )
    ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
    (setq vlist (append vlist (list (car vlist))))
    (repeat (1- (length vlist))
      (setq v1 (nth i vlist)
            v2 (nth (1+ i) vlist)
            i  (1+ i)
      )
      (if (edgeIntersectsRay pt v1 v2)
        (setq cnt (1+ cnt))
      )
    )
    ;; If the number of intersections with the ray is odd, the point inside
    (if (= (logand cnt 1) 1)
      T
      nil
    )
  )

  ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
  (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
    (setq px (car pt) py (cadr pt)
          x1 (car v1) y1 (cadr v1)
          x2 (car v2) y2 (cadr v2)
    )
    ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
    (if (> y1 y2)
      (progn
        (setq x1 (car v2) y1 (cadr v2)
              x2 (car v1) y2 (cadr v1))
      )
    )
    ;; Intersection condition:
    (and
      ;; 1) py is strictly above the lower vertex and not higher than the upper one
      (> py y1)
      (<= py y2)
      ;; 2) px < abscissas of the intersection point of the ray with the segment


(defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
  (setq px (car pt)
        py (cadr pt)
        x1 (car v1)
        y1 (cadr v1)
        x2 (car v2)
        y2 (cadr v2)
  )
)
  ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
  (if (> y1 y2)
    (setq x1 (car v2)
          y1 (cadr v2)
          x2 (car v1)
          y2 (cadr v1))
  )
)
  ;; Counting the intersection coordinate
  (setq intersectX
    (if (/= y2 y1)
      (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
      x1 ;; if the segment is horizontal, it is usually skipped.
    )
  )
  ;; We are returning (and ...), or nil
  (and
    (> py y1)     ;; a point above the lower vertex
    (<= py y2)    ;; and no higher than the top
    (> intersectX px)
  )
)
  ;;-----------------------------------------------
  ;; the main part
  ;;-----------------------------------------------
  (setq ent (car (entsel "\nChoose a closed linear polyline: ")))
  (if (null ent)
    (progn
      (prompt "\nThe polyline is not selected. Completion.")
      (princ)
    )
    (progn
      ;; 1) Step Request
      (setq step (getreal "\nEnter the step between the centers (мм): "))
      (if (or (null step) (<= step 0.0))
        (setq step 50.0)  ;; the "backup" option
      )

      ;; 2) Fixed radius
      (setq radius 25.0)

      ;; 3) List of vertices (minimum 3, otherwise not a polygon)
      (setq vlist (getPolyVertices ent))
      (if (< (length vlist) 3)
        (progn
          (prompt "\nThe polyline has <3 vertices, and the contour is incorrect.")
          (princ)
        )
        (progn
          ;; 4) Defining bounding box
          (setq minx (apply 'min (mapcar 'car  vlist))
                maxx (apply 'max (mapcar 'car  vlist))
                miny (apply 'min (mapcar 'cadr vlist))
                maxy (apply 'max (mapcar 'cadr vlist))
          )
          (prompt (strcat
            "\nboundary (bounding box) polyline:\n"
            "  X: " (rtos minx 2 2) " ... " (rtos maxx 2 2)
            "\n  Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2)
          ))

          ;; 5) Building a grid "in a staggered manner"
          (setq row 0
                y   miny
          )
          (while (<= y maxy)
            ;; For an odd row row, we shift X by step/2
            (if (oddp row)
              (setq x (+ minx (/ step 2.0)))
              (setq x minx)
            )

            (while (<= x maxx)
              (setq pt (list x y))
              ;; If the center is inside the polyline, draw a circle.
              (if (pointInPolygon pt vlist)
                (command "_.CIRCLE" pt radius)
              )
              (setq x (+ x step))
            )
            (setq y   (+ y step))
            (setq row (1+ row))
          )
        )
      )
    )
  )
  (princ)
)

 

closed outline.png

 

closed outline 1.png

Edited by Nikon
Posted

Your 'pointInPolygon' function is not working as expected.
I suggest you replace it with this one:

 

(defun comprobar_centralidad (pto		 lst_ptos_rto  /
			   pt_inters+	 pt_inters-    n
			   pt1		 pt2	       inters_negat
			   inters_posit	
			  )
  (setq n 0)
  (repeat (- (length lst_ptos_rto) 1)
    (setq pt_inters+
	   (inters pto
		   (list (+ (car pto) 100000) (cadr pto))
		   (setq pt1 (nth n lst_ptos_rto))
		   (setq pt2 (nth (+ n 1) lst_ptos_rto))
	   )
    )

    (if	(and pt_inters+
	     (not (member (cons 10 pt_inters+) lst_ptos_rto))
	)
      (if inters_posit
	(setq inters_posit (+ inters_posit 1))
	(setq inters_posit 1)
      )
    )

    (setq pt_inters-
	   (inters pto
		   (list (- (car pto) 100000) (cadr pto))
		   pt1
		   pt2
	   )
    )
    (if	(and pt_inters-
	     (not (member (cons 10 pt_inters-) lst_ptos_rto))
	)
      (if inters_negat
	(setq inters_negat (+ inters_negat 1))
	(setq inters_negat 1)
      )
    )
    (setq n (+ n 1))
  )
  (if (and (= (rem (if (not inters_negat)
		     0
		     inters_negat
		   )
		   2
	      )
	      0
	   )
	   (= (rem (if (not inters_posit)
		     0
		     inters_posit
		   )
		   2
	      )
	      0
	   )
      )
    nil
    T
  )
)

 

  • Like 1
Posted (edited)

Circles are created with 'command': this means that they are object-snap sensitive.
Always turn off object-snap to avoid undesired results. Or modify your code to turn off object-snap at the beginning of code execution.

Edited by GLAVCVS
  • Like 1
Posted

This is another that could be used as a start point just work out max rows and columns rather than enter.

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/rectangular-array-creating-every-other-row-offset/td-p/9667120
; array rows a 1/2 x spacings
; Enter -ve values to change direction.
;By AlanH info@alanh.com.au Aug 2020

(defun c:zigzag ( / ent ss ans hor ver numx numy x )
(setq ent (entsel "\nSelect object to array"))
(setq ss (ssadd))
(ssadd (car ent) ss)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter spacings " "Horizontal  " 5 4 "100" "Vertical" 5 4 "50" "Num X " 5 4 "3"  "Num Y" 5 4 "3")))
(setq hor (atof (nth 0 ans)))
(setq ver (atof (nth 1 ans)))
(setq numx (atoi (nth 2 ans)))
(setq numy (atoi (nth 3 ans)))
(setq x 1.0)
(repeat (- numx 1)
(command "copy" ent "" (list 0.0 0.0) (list  (* x hor) 0.0) )
(ssadd (entlast) ss)
(setq x (+ x 1))
)
(setq x 1.0)
(while (< x numy)
(command "copy" ss "" (list 0.0 0.0) (list (* 0.5 (- hor)) (* x ver)))
(setq x (+ x 2))
)
(setq x 2.0)
(while (< x numy)
(command "copy" ss "" (list 0.0 0.0) (list 0.0 (* ver x)))
(setq x (+ x 2))
)
(princ)
)
(c:zigzag)

Multi GETVALS.lsp

  • Like 1
Posted
10 hours ago, GLAVCVS said:

Your 'pointInPolygon' function is not working as expected.

(defun comprobar_centralidad (pto lst_ptos_rto /

I am replacing these lines, but the code gives an error.

(defun pointInPolygon (pt vlist / cnt i v1 v2)
 (setq cnt 0
 i 0
 )

 

 

(defun c:Circles_Chess_outl1 (/ oddp ent step radius vlist minx miny maxx maxy x y row pt)
 ;;-----------------------------------------------
 ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
 ;;-----------------------------------------------
 (defun oddp (n)
 (= (logand (fix n) 1) 1)
 )

 ;;-----------------------------------------------
 ;; Local auxiliary functions
 ;;-----------------------------------------------

 ;; Extracting a list of vertices (points) of a linear 2D polyline:
 (defun getPolyVertices (e / ed lst pts)
 (setq ed (entget e)
 ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
 lst (vl-remove-if-not
 '(lambda (x) (= (car x) 10))
 ed
 )
 ;; turning them into a regular list of points (x y)
 pts (mapcar 'cdr lst)
 )
 pts
 )

 ;; Checking whether the pt point is located inside the linear polygon v list:
 ;(defun pointInPolygon (pt vlist / cnt i v1 v2)
 ;(setq cnt 0
 ;i 0
 ;)
 (defun comprobar_centralidad (pto lst_ptos_rto /
 pt_inters+ pt_inters- n
 pt1 pt2 inters_negat
 inters_posit 
 )
 (setq n 0)
 (repeat (- (length lst_ptos_rto) 1)
 (setq pt_inters+
 (inters pto
 (list (+ (car pto) 100000) (cadr pto))
 (setq pt1 (nth n lst_ptos_rto))
 (setq pt2 (nth (+ n 1) lst_ptos_rto))
 )
 )

 (if (and pt_inters+
 (not (member (cons 10 pt_inters+) lst_ptos_rto))
 )
 (if inters_posit
 (setq inters_posit (+ inters_posit 1))
 (setq inters_posit 1)
 )
 )

 (setq pt_inters-
 (inters pto
 (list (- (car pto) 100000) (cadr pto))
 pt1
 pt2
 )
 )
 (if (and pt_inters-
 (not (member (cons 10 pt_inters-) lst_ptos_rto))
 )
 (if inters_negat
 (setq inters_negat (+ inters_negat 1))
 (setq inters_negat 1)
 )
 )
 (setq n (+ n 1))
 )
 (if (and (= (rem (if (not inters_negat)
 0
 inters_negat
 )
 2
 )
 0
 )
 (= (rem (if (not inters_posit)
 0
 inters_posit
 )
 2
 )
 0
 )
 )
 nil
 T
 )
)

 ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
 (setq vlist (append vlist (list (car vlist))))
 (repeat (1- (length vlist))
 (setq v1 (nth i vlist)
 v2 (nth (1+ i) vlist)
 i (1+ i)
 )
 (if (edgeIntersectsRay pt v1 v2)
 (setq cnt (1+ cnt))
 )
 )
 ;; If the number of intersections with the ray is odd, the point inside
 (if (= (logand cnt 1) 1)
 T
 nil
 )
 )

 ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
 (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
 (setq px (car pt) py (cadr pt)
 x1 (car v1) y1 (cadr v1)
 x2 (car v2) y2 (cadr v2)
 )
 ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
 (if (> y1 y2)
 (progn
 (setq x1 (car v2) y1 (cadr v2)
 x2 (car v1) y2 (cadr v1))
 )
 )
 ;; Intersection condition:
 (and
 ;; 1) py is strictly above the lower vertex and not higher than the upper one
 (> py y1)
 (<= py y2)
 ;; 2) px < abscissas of the intersection point of the ray with the segment


(defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
 (setq px (car pt)
 py (cadr pt)
 x1 (car v1)
 y1 (cadr v1)
 x2 (car v2)
 y2 (cadr v2)
 )
)
 ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
 (if (> y1 y2)
 (setq x1 (car v2)
 y1 (cadr v2)
 x2 (car v1)
 y2 (cadr v1))
 )
)
 ;; Counting t
  intersection coordinate
 (setq intersectX
 (if (/= y2 y1)
 (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
 x1 ;; if the segment is horizontal, it is usually skipped.
 )
 )
 ;; We are returning (and ...), or nil
 (and
 (> py y1) ;; a point above the lower vertex
 (<= py y2) ;; and no higher than the top
 (> intersectX px)
 )
)
 ;;-----------------------------------------------
 ;; the main part
 ;;-----------------------------------------------
 (setq ent (car (entsel "\nChoose a closed linear polyline: ")))
 (if (null ent)
 (progn
 (prompt "\nThe polyline is not selected. Completion.")
 (princ)
 )
 (progn
 ;; 1) Step Request
 (setq step (getreal "\nEnter the step between the centers (мм): "))
 (if (or (null step) (<= step 0.0))
 (setq step 50.0) ;; the "backup" option
 )

 ;; 2) Fixed radius
 (setq radius 25.0)

 ;; 3) List of vertices (minimum 3, otherwise not a polygon)
 (setq vlist (getPolyVertices ent))
 (if (< (length vlist) 3)
 (progn
 (prompt "\nThe polyline has <3 vertices, and the contour is incorrect.")
 (princ)
 )
 (progn
 ;; 4) Defining bounding box
 (setq minx (apply 'min (mapcar 'car vlist))
 maxx (apply 'max (mapcar 'car vlist))
 miny (apply 'min (mapcar 'cadr vlist))
 maxy (apply 'max (mapcar 'cadr vlist))
 )
 (prompt (strcat
 "\nboundary (bounding box) polyline:\n"
 " X: " (rtos minx 2 2) " ... " (rtos maxx 2 2)
 "\n Y: " (rtos miny 2 2) " ... " (rtos maxy 2 2)
 ))

 ;; 5) Building a grid "in a staggered manner"
 (setq row 0
 y miny
 )
 (while (<= y maxy)
 ;; For an odd row row, we shift X by step/2
 (if (oddp row)
 (setq x (+ minx (/ step 2.0)))
 (setq x minx)
 )

 (while (<= x maxx)
 (setq pt (list x y))
 ;; If the center is inside the polyline, draw a circle.
 ;(if (pointInPolygon pt vlist)
 (if (comprobar_centralidad pt vlist)
 (command "_.CIRCLE" pt radius)
 )
 (setq x (+ x step))
 )
 (setq y (+ y step))
 (setq row (1+ row))
 )
 )
 )
 )
 )
 (princ)
)

no function definition: GETPOLYVERTICES
And now even one circle is not created...

Posted

 

I think you haven't implemented it right.
Try this one

 

(defun c:Circles_Chess_outl (/	    oddp   ent	  step	 radius	vlist
			     minx   miny   maxx	  maxy	 x	y
			     row    pt
			    )
  ;;-----------------------------------------------
  ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
  ;;-----------------------------------------------
  (defun oddp (n)
    (= (logand (fix n) 1) 1)
  )

  ;;-----------------------------------------------
  ;; Local auxiliary functions
  ;;-----------------------------------------------

  ;; Extracting a list of vertices (points) of a linear 2D polyline:
  (defun getPolyVertices (e / ed lst pts)
    (setq ed  (entget e)
	  ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
	  lst (vl-remove-if-not
		'(lambda (x) (= (car x) 10))
		ed
	      )
	  ;; turning them into a regular list of points (x y)
	  pts (mapcar 'cdr lst)
    )
    pts
  )

  ;; Checking whether the pt point is located inside the linear polygon v list:
;;;  (defun pointInPolygon (pt vlist / cnt i v1 v2)
;;;    (setq cnt 0
;;;          i   0
;;;    )
;;;    ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
;;;    (setq vlist (append vlist (list (car vlist))))
;;;    (repeat (1- (length vlist))
;;;      (setq v1 (nth i vlist)
;;;            v2 (nth (1+ i) vlist)
;;;            i  (1+ i)
;;;      )
;;;      (if (edgeIntersectsRay pt v1 v2)
;;;        (setq cnt (1+ cnt))
;;;      )
;;;    )
;;;    ;; If the number of intersections with the ray is odd, the point inside
;;;    (if (= (logand cnt 1) 1)
;;;      T
;;;      nil
;;;    )
;;;  )

  (defun comprobar_centralidad (pto	     lst_ptos_rto /
				pt_inters+   pt_inters-	  n
				pt1	     pt2	  inters_negat
				inters_posit
			       )
    (setq n 0)
    (repeat (- (length lst_ptos_rto) 1)
      (setq pt_inters+
	     (inters pto
		     (list (+ (car pto) 100000) (cadr pto))
		     (setq pt1 (nth n lst_ptos_rto))
		     (setq pt2 (nth (+ n 1) lst_ptos_rto))
	     )
      )

      (if (and pt_inters+
	       (not (member (cons 10 pt_inters+) lst_ptos_rto))
	  )
	(if inters_posit
	  (setq inters_posit (+ inters_posit 1))
	  (setq inters_posit 1)
	)
      )

      (setq pt_inters-
	     (inters pto
		     (list (- (car pto) 100000) (cadr pto))
		     pt1
		     pt2
	     )
      )
      (if (and pt_inters-
	       (not (member (cons 10 pt_inters-) lst_ptos_rto))
	  )
	(if inters_negat
	  (setq inters_negat (+ inters_negat 1))
	  (setq inters_negat 1)
	)
      )
      (setq n (+ n 1))
    )
    (if	(and (=	(rem (if (not inters_negat)
		       0
		       inters_negat
		     )
		     2
		)
		0
	     )
	     (=	(rem (if (not inters_posit)
		       0
		       inters_posit
		     )
		     2
		)
		0
	     )
	)
      nil
      T
    )
  )

  ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
  (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
    (setq px (car pt)
	  py (cadr pt)
	  x1 (car v1)
	  y1 (cadr v1)
	  x2 (car v2)
	  y2 (cadr v2)
    )
    ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
    (if	(> y1 y2)
      (progn
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Intersection condition:
    (and
      ;; 1) py is strictly above the lower vertex and not higher than the upper one
      (> py y1)
      (<= py y2)
      ;; 2) px < abscissas of the intersection point of the ray with the segment


      (defun edgeIntersectsRay
	     (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
	(setq px (car pt)
	      py (cadr pt)
	      x1 (car v1)
	      y1 (cadr v1)
	      x2 (car v2)
	      y2 (cadr v2)
	)
      )
      ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
      (if (> y1 y2)
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Counting the intersection coordinate
    (setq intersectX
	   (if (/= y2 y1)
	     (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
	     x1
	     ;; if the segment is horizontal, it is usually skipped.
	   )
    )
    ;; We are returning (and ...), or nil
    (and
      (> py y1)
      ;; a point above the lower vertex
      (<= py y2)
      ;; and no higher than the top
      (> intersectX px)
    )
  )
  ;;-----------------------------------------------
  ;; the main part
  ;;-----------------------------------------------
  (setq ent (car (entsel "\nChoose a closed linear polyline: ")))
  (if (null ent)
    (progn
      (prompt "\nThe polyline is not selected. Completion.")
      (princ)
    )
    (progn
      ;; 1) Step Request
      (setq
	step (getreal "\nEnter the step between the centers (??): ")
      )
      (if (or (null step) (<= step 0.0))
	(setq step 50.0)
	;; the "backup" option
      )

      ;; 2) Fixed radius
      (setq radius 25.0)

      ;; 3) List of vertices (minimum 3, otherwise not a polygon)
      (setq vlist (getPolyVertices ent))
      (if (< (length vlist) 3)
	(progn
	  (prompt
	    "\nThe polyline has <3 vertices, and the contour is incorrect."
	  )
	  (princ)
	)
	(progn
	  ;; 4) Defining bounding box
	  (setq	minx (apply 'min (mapcar 'car vlist))
		maxx (apply 'max (mapcar 'car vlist))
		miny (apply 'min (mapcar 'cadr vlist))
		maxy (apply 'max (mapcar 'cadr vlist))
	  )
	  (prompt (strcat
		    "\nboundary (bounding box) polyline:\n"
		    "  X: "
		    (rtos minx 2 2)
		    " ... "
		    (rtos maxx 2 2)
		    "\n  Y: "
		    (rtos miny 2 2)
		    " ... "
		    (rtos maxy 2 2)
		  )
	  )

	  ;; 5) Building a grid "in a staggered manner"
	  (setq	row 0
		y   miny
	  )
	  (while (<= y maxy)
	    ;; For an odd row row, we shift X by step/2
	    (if	(oddp row)
	      (setq x (+ minx (/ step 2.0)))
	      (setq x minx)
	    )

	    (while (<= x maxx)
	      (setq pt (list x y))
	      ;; If the center is inside the polyline, draw a circle.
	      (if (comprobar_centralidad pt vlist);(pointInPolygon pt vlist)
		(command "_.CIRCLE" pt radius)
	      )
	      (setq x (+ x step))
	    )
	    (setq y (+ y step))
	    (setq row (1+ row))
	  )
	)
      )
    )
  )
  (princ)
)

 

  • Thanks 1
Posted (edited)
40 minutes ago, GLAVCVS said:

I think you haven't implemented it right.
his one

@GLAVCVS thanks, but the code was working a little incorrectly...

 

5.png

Edited by Nikon
Posted

As I told you before, turn off object snapping - it looks like it's on with endpoint and midpoint

  • Thanks 1
Posted

Or write at the beginning of the code:
(setvar "osmode" 0)

  • Thanks 1
Posted

Like that

 

 

(defun c:Circles_Chess_outl (/	    oddp   ent	  step	 radius	vlist
			     minx   miny   maxx	  maxy	 x	y
			     row    pt	   osmant
			    )
  ;;-----------------------------------------------
  ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
  ;;-----------------------------------------------
  (defun oddp (n)
    (= (logand (fix n) 1) 1)
  )

  ;;-----------------------------------------------
  ;; Local auxiliary functions
  ;;-----------------------------------------------

  ;; Extracting a list of vertices (points) of a linear 2D polyline:
  (defun getPolyVertices (e / ed lst pts)
    (setq ed  (entget e)
	  ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
	  lst (vl-remove-if-not
		'(lambda (x) (= (car x) 10))
		ed
	      )
	  ;; turning them into a regular list of points (x y)
	  pts (mapcar 'cdr lst)
    )
    pts
  )

  ;; Checking whether the pt point is located inside the linear polygon v list:
;;;  (defun pointInPolygon (pt vlist / cnt i v1 v2)
;;;    (setq cnt 0
;;;          i   0
;;;    )
;;;    ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
;;;    (setq vlist (append vlist (list (car vlist))))
;;;    (repeat (1- (length vlist))
;;;      (setq v1 (nth i vlist)
;;;            v2 (nth (1+ i) vlist)
;;;            i  (1+ i)
;;;      )
;;;      (if (edgeIntersectsRay pt v1 v2)
;;;        (setq cnt (1+ cnt))
;;;      )
;;;    )
;;;    ;; If the number of intersections with the ray is odd, the point inside
;;;    (if (= (logand cnt 1) 1)
;;;      T
;;;      nil
;;;    )
;;;  )

  (defun comprobar_centralidad (pto	     lst_ptos_rto /
				pt_inters+   pt_inters-	  n
				pt1	     pt2	  inters_negat
				inters_posit
			       )
    (setq n 0)
    (repeat (- (length lst_ptos_rto) 1)
      (setq pt_inters+
	     (inters pto
		     (list (+ (car pto) 100000) (cadr pto))
		     (setq pt1 (nth n lst_ptos_rto))
		     (setq pt2 (nth (+ n 1) lst_ptos_rto))
	     )
      )

      (if (and pt_inters+
	       (not (member (cons 10 pt_inters+) lst_ptos_rto))
	  )
	(if inters_posit
	  (setq inters_posit (+ inters_posit 1))
	  (setq inters_posit 1)
	)
      )

      (setq pt_inters-
	     (inters pto
		     (list (- (car pto) 100000) (cadr pto))
		     pt1
		     pt2
	     )
      )
      (if (and pt_inters-
	       (not (member (cons 10 pt_inters-) lst_ptos_rto))
	  )
	(if inters_negat
	  (setq inters_negat (+ inters_negat 1))
	  (setq inters_negat 1)
	)
      )
      (setq n (+ n 1))
    )
    (if	(and (=	(rem (if (not inters_negat)
		       0
		       inters_negat
		     )
		     2
		)
		0
	     )
	     (=	(rem (if (not inters_posit)
		       0
		       inters_posit
		     )
		     2
		)
		0
	     )
	)
      nil
      T
    )
  )

  ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
  (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
    (setq px (car pt)
	  py (cadr pt)
	  x1 (car v1)
	  y1 (cadr v1)
	  x2 (car v2)
	  y2 (cadr v2)
    )
    ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
    (if	(> y1 y2)
      (progn
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Intersection condition:
    (and
      ;; 1) py is strictly above the lower vertex and not higher than the upper one
      (> py y1)
      (<= py y2)
      ;; 2) px < abscissas of the intersection point of the ray with the segment


      (defun edgeIntersectsRay
	     (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
	(setq px (car pt)
	      py (cadr pt)
	      x1 (car v1)
	      y1 (cadr v1)
	      x2 (car v2)
	      y2 (cadr v2)
	)
      )
      ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
      (if (> y1 y2)
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Counting the intersection coordinate
    (setq intersectX
	   (if (/= y2 y1)
	     (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
	     x1
	     ;; if the segment is horizontal, it is usually skipped.
	   )
    )
    ;; We are returning (and ...), or nil
    (and
      (> py y1)
      ;; a point above the lower vertex
      (<= py y2)
      ;; and no higher than the top
      (> intersectX px)
    )
  )
  ;;-----------------------------------------------
  ;; the main part
  ;;-----------------------------------------------
  (setq ent (car (entsel "\nChoose a closed linear polyline: ")))

  (if (null ent)
    (progn
      (prompt "\nThe polyline is not selected. Completion.")
      (princ)
    )
    (progn
      ;; 1) Step Request
      (setq
	step (getreal "\nEnter the step between the centers (??): ")
      )
      (if (or (null step) (<= step 0.0))
	(setq step 50.0)
	;; the "backup" option
      )

      ;; 2) Fixed radius
      (setq radius 25.0)

      ;; 3) List of vertices (minimum 3, otherwise not a polygon)
      (setq vlist (getPolyVertices ent))
      (if (< (length vlist) 3)
	(progn
	  (prompt
	    "\nThe polyline has <3 vertices, and the contour is incorrect."
	  )
	  (princ)
	)
	(progn
	  ;; 4) Defining bounding box
	  (setq	minx (apply 'min (mapcar 'car vlist))
		maxx (apply 'max (mapcar 'car vlist))
		miny (apply 'min (mapcar 'cadr vlist))
		maxy (apply 'max (mapcar 'cadr vlist))
	  )
	  (prompt (strcat
		    "\nboundary (bounding box) polyline:\n"
		    "  X: "
		    (rtos minx 2 2)
		    " ... "
		    (rtos maxx 2 2)
		    "\n  Y: "
		    (rtos miny 2 2)
		    " ... "
		    (rtos maxy 2 2)
		  )
	  )

	  ;; 5) Building a grid "in a staggered manner"
	  (setq	row 0
		y   miny
	  )
	  (setq osmant (getvar "osmode"))
	  (setvar "osmode" 0)
	  (while (<= y maxy)
	    ;; For an odd row row, we shift X by step/2
	    (if	(oddp row)
	      (setq x (+ minx (/ step 2.0)))
	      (setq x minx)
	    )

	    (while (<= x maxx)
	      (setq pt (list x y))
	      ;; If the center is inside the polyline, draw a circle.
	      (if (comprobar_centralidad pt vlist)
					;(pointInPolygon pt vlist)
		(command "_.CIRCLE" pt radius)
	      )
	      (setq x (+ x step))
	    )
	    (setq y (+ y step))
	    (setq row (1+ row))
	  )
	  (setvar "osmode" osmant)
	)
      )
    )
  )
  (princ)
)

 

  • Like 1
Posted (edited)
1 hour ago, GLAVCVS said:

Like that

@GLAVCVS Thanks a lot! Now the code works beautifully!

I want to go a little further and add to the code a count of the elements inside the contour  with the output of the value in the drawing...

;; counting elements inside a contour
(defun c:WP-count()
   (setq pl (car (entsel "select border polyline\n"))
	points (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
	)
  (strcat (itoa (sslength (ssget "_wp" points))) " entities found")
  )
;+ specify the insertion point of the result...

 

Edited by Nikon
Posted

for creating entities if snapping is going to be a problem I'd use entmake or entmakex to draw what you need - especially a simple one like a circle. Saves worrying about setting system variables and resetting them after.

 

For a count set a variable earlier in the code, say (setq acounter 0). For counting add a (setq acounter (+ acounter 1)) just after you draw the circle (you'll need to add a (progn for the 'if' too)... an easy count of how many circles were drawn

  • Thanks 1
Posted (edited)


My addition for counting elements returns an error... 
; error: invalid argument type: lselsetp nil
how can this be fixed?

;; GLAVCVS 21.01.2025
;; https://www.cadtutor.net/forum/topic/96029-place-the-circles-in-a-checkerboard-pattern/
;; Arrange the circles in a checkerboard pattern in a closed loop
(defun c:Circl_Chess_outl_WP (/ oddp ent step radius vlist minx miny maxx maxy x y row pt osmant)
 ;;-----------------------------------------------
 ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
 ;;-----------------------------------------------
 (defun oddp (n)
 (= (logand (fix n) 1) 1)
 )

 ;;-----------------------------------------------
 ;; Local auxiliary functions
 ;;-----------------------------------------------

 ;; Extracting a list of vertices (points) of a linear 2D polyline:
 (defun getPolyVertices (e / ed lst pts)
 (setq ed (entget e)
 ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
 lst (vl-remove-if-not
 '(lambda (x) (= (car x) 10))
 ed
 )
 ;; turning them into a regular list of points (x y)
 pts (mapcar 'cdr lst)
 )
 pts
 )

 ;; Checking whether the pt point is located inside the linear polygon v list:
;;; (defun pointInPolygon (pt vlist / cnt i v1 v2)
;;; (setq cnt 0
;;; i 0
;;; )
;;; ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
;;; (setq vlist (append vlist (list (car vlist))))
;;; (repeat (1- (length vlist))
;;; (setq v1 (nth i vlist)
;;; v2 (nth (1+ i) vlist)
;;; i (1+ i)
;;; )
;;; (if (edgeIntersectsRay pt v1 v2)
;;; (setq cnt (1+ cnt))
;;; )
;;; )
;;; ;; If the number of intersections with the ray is odd, the point inside
;;; (if (= (logand cnt 1) 1)
;;; T
;;; nil
;;; )
;;; )

 (defun comprobar_centralidad (pto lst_ptos_rto /
 pt_inters+ pt_inters- n
 pt1 pt2 inters_negat
 inters_posit
 )
 (setq n 0)
 (repeat (- (length lst_ptos_rto) 1)
 (setq pt_inters+
 (inters pto
 (list (+ (car pto) 100000) (cadr pto))
 (setq pt1 (nth n lst_ptos_rto))
 (setq pt2 (nth (+ n 1) lst_ptos_rto))
 )
 )

 (if (and pt_inters+
 (not (member (cons 10 pt_inters+) lst_ptos_rto))
 )
 (if inters_posit
 (setq inters_posit (+ inters_posit 1))
 (setq inters_posit 1)
 )
 )

 (setq pt_inters-
 (inters pto
 (list (- (car pto) 100000) (cadr pto))
 pt1
 pt2
 )
 )
 (if (and pt_inters-
 (not (member (cons 10 pt_inters-) lst_ptos_rto))
 )
 (if inters_negat
 (setq inters_negat (+ inters_negat 1))
 (setq inters_negat 1)
 )
 )
 (setq n (+ n 1))
 )
 (if (and (= (rem (if (not inters_negat)
 0
 inters_negat
 )
 2
 )
 0
 )
 (= (rem (if (not inters_posit)
 0
 inters_posit
 )
 2
 )
 0
 )
 )
 nil
 T
 )
 )

 ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
 (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
 (setq px (car pt)
 py (cadr pt)
 x1 (car v1)
 y1 (cadr v1)
 x2 (car v2)
 y2 (cadr v2)
 )
 ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
 (if (> y1 y2)
 (progn
 (setq x1 (car v2)
 y1 (cadr v2)
 x2 (car v1)
 y2 (cadr v1)
 )
 )
 )
 ;; Intersection condition:
 (and
 ;; 1) py is strictly above the lower vertex and not higher than the upper one
 (> py y1)
 (<= py y2)
 ;; 2) px < abscissas of the intersection point of the ray with the segment


 (defun edgeIntersectsRay
 (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
 (setq px (car pt)
 py (cadr pt)
 x1 (car v1)
 y1 (cadr v1)
 x2 (car v2)
 y2 (cadr v2)
 )
 )
 ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
 (if (> y1 y2)
 (setq x1 (car v2)
 y1 (cadr v2)
 x2 (car v1)
 y2 (cadr v1)
 )
 )
 )
 ;; Counting the intersection coordinate
 (setq intersectX
 (if (/= y2 y1)
 (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
 x1
 ;; if the segment is horizontal, it is usually skipped.
 )
 )
 ;; We are returning (and ...), or nil
 (and
 (> py y1)
 ;; a point above the lower vertex
 (<= py y2)
 ;; and no higher than the top
 (> intersectX px)
 )
 )
 ;;-----------------------------------------------
 ;; the main part
 ;;-----------------------------------------------
 (setq ent (car (entsel "\nChoose a closed linear polyline: ")))

 (if (null ent)
 (progn
 (prompt "\nThe polyline is not selected. Completion.")
 (princ)
 )
 (progn
 ;; 1) Step Request
 (setq
 step (getreal "\nEnter the step between the centers (??): ")
 )
 (if (or (null step) (<= step 0.0))
 (setq step 50.0)
 ;; the "backup" option
 )

 ;; 2) Fixed radius
 (setq radius 25.0)

 ;; 3) List of vertices (minimum 3, otherwise not a polygon)
 (setq vlist (getPolyVertices ent))
 (if (< (length vlist) 3)
 (progn
 (prompt
 "\nThe polyline has <3 vertices, and the contour is incorrect."
 )
 (princ)
 )
 (progn
 ;; 4) Defining bounding box
 (setq minx (apply 'min (mapcar 'car vlist))
 maxx (apply 'max (mapcar 'car vlist))
 miny (apply 'min (mapcar 'cadr vlist))
 maxy (apply 'max (mapcar 'cadr vlist))
 )
 (prompt (strcat
 "\nboundary (bounding box) polyline:\n"
 " X: "
 (rtos minx 2 2)
 " ... "
 (rtos maxx 2 2)
 "\n Y: "
 (rtos miny 2 2)
 " ... "
 (rtos maxy 2 2)
 )
 )

 ;; 5) Building a grid "in a staggered manner"
 (setq row 0
 y miny
 )
 (setq osmant (getvar "osmode"))
 (setvar "osmode" 0)
 (while (<= y maxy)
 ;; For an odd row row, we shift X by step/2
 (if (oddp row)
 (setq x (+ minx (/ step 2.0)))
 (setq x minx)
 )

 (while (<= x maxx)
 (setq pt (list x y))
 ;; If the center is inside the polyline, draw a circle.
 (if (comprobar_centralidad pt vlist)
 ;(pointInPolygon pt vlist)
 (command "_.CIRCLE" pt radius)
 )
 (setq x (+ x step))
 )
 (setq y (+ y step))
 (setq row (1+ row))
 )
 (setvar "osmode" osmant)
 )
 )
 )
 )
 (princ)
)
 ;; ssget "_WP"
  (setq pl (car (entsel "\nSelect border polyline: ")))
  (if (null pl)
    (progn
      (prompt "\nNo polyline selected. Cancel.")
      (princ)
    )
    (progn
    
      (setq points
        (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
      )
     
      (setq n (sslength (ssget "_WP" points)))  
      (if (null n) (setq n 0)) 
      
      (setq sres (strcat (itoa n) " "))
     
      (prompt (strcat "\n" sres))

          (setq ip (getpoint "\nSpecify insertion point for the text: "))
      (if ip
        (progn
                             (if (or (null textHeight) (<= textHeight 0.0))
            (setq textHeight 50.0) 
          )

         
          (command "_.TEXT" "_J" "_MC" ip textHeight "0" sres)

                   (prompt "\nDone.")
          (princ)
        )
        (progn
          (prompt "\nNo insertion point specified. Cancel.")
          (princ)
        )
      )
    )
  )
(princ)
)

 

 

Edited by Nikon
Posted (edited)

Separately, this code works

(defun c:WP-count-txt (/ pl points n sres ip textHeight)
 
  (setq pl (car (entsel "\nSelect border polyline: ")))
  (if (null pl)
    (progn
      (prompt "\nNo polyline selected. Cancel.")
      (princ)
    )
    (progn
     
      (setq points
        (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
      )
     
      (setq n (sslength (ssget "_WP" points)))  
      (if (null n) (setq n 0)) 
      (setq sres (strcat (itoa n) " "))

                 (setq ip (getpoint "\nSpecify insertion point for the text: "))
      (if ip
        (progn
         
          (if (or (null textHeight) (<= textHeight 0.0))
            (setq textHeight 50.0) 
          )

                    (command "_.TEXT" "_J" "_MC" ip textHeight "0" sres)

                 (prompt "\nDone.")
          (princ)
        )
        (progn
          (prompt "\nNo insertion point specified. Cancel.")
          (princ)
        )
      )
    )
  )
  (princ)
)

But together with the Circle_Check_out_WP code, this does not work.

???

Edited by Nikon
Posted
(defun c:Circles_Chess_outl (/	    oddp   ent	  step	 radius	vlist
			     minx   miny   maxx	  maxy	 x	y
			     row    pt	   osmant circulos    creaMTEXT
			    )
  ;;-----------------------------------------------
  ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
  ;;-----------------------------------------------
  (defun oddp (n)
    (= (logand (fix n) 1) 1)
  )

  ;;-----------------------------------------------
  ;; Local auxiliary functions
  ;;-----------------------------------------------

  ;; Extracting a list of vertices (points) of a linear 2D polyline:
  (defun getPolyVertices (e / ed lst pts)
    (setq ed  (entget e)
	  ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
	  lst (vl-remove-if-not
		'(lambda (x) (= (car x) 10))
		ed
	      )
	  ;; turning them into a regular list of points (x y)
	  pts (mapcar 'cdr lst)
    )
    pts
  )

  ;; Checking whether the pt point is located inside the linear polygon v list:
;;;  (defun pointInPolygon (pt vlist / cnt i v1 v2)
;;;    (setq cnt 0
;;;          i   0
;;;    )
;;;    ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
;;;    (setq vlist (append vlist (list (car vlist))))
;;;    (repeat (1- (length vlist))
;;;      (setq v1 (nth i vlist)
;;;            v2 (nth (1+ i) vlist)
;;;            i  (1+ i)
;;;      )
;;;      (if (edgeIntersectsRay pt v1 v2)
;;;        (setq cnt (1+ cnt))
;;;      )
;;;    )
;;;    ;; If the number of intersections with the ray is odd, the point inside
;;;    (if (= (logand cnt 1) 1)
;;;      T
;;;      nil
;;;    )
;;;  )

  (defun comprobar_centralidad (pto	     lst_ptos_rto /
				pt_inters+   pt_inters-	  n
				pt1	     pt2	  inters_negat
				inters_posit
			       )
    (setq n 0)
    (repeat (- (length lst_ptos_rto) 1)
      (setq pt_inters+
	     (inters pto
		     (list (+ (car pto) 100000) (cadr pto))
		     (setq pt1 (nth n lst_ptos_rto))
		     (setq pt2 (nth (+ n 1) lst_ptos_rto))
	     )
      )

      (if (and pt_inters+
	       (not (member (cons 10 pt_inters+) lst_ptos_rto))
	  )
	(if inters_posit
	  (setq inters_posit (+ inters_posit 1))
	  (setq inters_posit 1)
	)
      )

      (setq pt_inters-
	     (inters pto
		     (list (- (car pto) 100000) (cadr pto))
		     pt1
		     pt2
	     )
      )
      (if (and pt_inters-
	       (not (member (cons 10 pt_inters-) lst_ptos_rto))
	  )
	(if inters_negat
	  (setq inters_negat (+ inters_negat 1))
	  (setq inters_negat 1)
	)
      )
      (setq n (+ n 1))
    )
    (if	(and (=	(rem (if (not inters_negat)
		       0
		       inters_negat
		     )
		     2
		)
		0
	     )
	     (=	(rem (if (not inters_posit)
		       0
		       inters_posit
		     )
		     2
		)
		0
	     )
	)
      nil
      T
    )
  )

  (defun creaMTEXT (texto altura / vlaEnt)
    (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj)))))
    (vlax-put-property vlaEnt "Height" altura)
  )

  ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
  (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
    (setq px (car pt)
	  py (cadr pt)
	  x1 (car v1)
	  y1 (cadr v1)
	  x2 (car v2)
	  y2 (cadr v2)
    )
    ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
    (if	(> y1 y2)
      (progn
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Intersection condition:
    (and
      ;; 1) py is strictly above the lower vertex and not higher than the upper one
      (> py y1)
      (<= py y2)
      ;; 2) px < abscissas of the intersection point of the ray with the segment


      (defun edgeIntersectsRay
	     (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
	(setq px (car pt)
	      py (cadr pt)
	      x1 (car v1)
	      y1 (cadr v1)
	      x2 (car v2)
	      y2 (cadr v2)
	)
      )
      ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
      (if (> y1 y2)
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Counting the intersection coordinate
    (setq intersectX
	   (if (/= y2 y1)
	     (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
	     x1
	     ;; if the segment is horizontal, it is usually skipped.
	   )
    )
    ;; We are returning (and ...), or nil
    (and
      (> py y1)
      ;; a point above the lower vertex
      (<= py y2)
      ;; and no higher than the top
      (> intersectX px)
    )
  )
  ;;-----------------------------------------------
  ;; the main part
  ;;-----------------------------------------------
  (setq ent (car (entsel "\nChoose a closed linear polyline: ")))

  (if (null ent)
    (progn
      (prompt "\nThe polyline is not selected. Completion.")
      (princ)
    )
    (progn
      ;; 1) Step Request
      (setq
	step (getreal "\nEnter the step between the centers (??): ")
      )
      (if (or (null step) (<= step 0.0))
	(setq step 50.0)
	;; the "backup" option
      )

      ;; 2) Fixed radius
      (setq radius 25.0)

      ;; 3) List of vertices (minimum 3, otherwise not a polygon)
      (setq vlist (getPolyVertices ent))
      (if (< (length vlist) 3)
	(progn
	  (prompt
	    "\nThe polyline has <3 vertices, and the contour is incorrect."
	  )
	  (princ)
	)
	(progn
	  ;; 4) Defining bounding box
	  (setq	minx (apply 'min (mapcar 'car vlist))
		maxx (apply 'max (mapcar 'car vlist))
		miny (apply 'min (mapcar 'cadr vlist))
		maxy (apply 'max (mapcar 'cadr vlist))
	  )
	  (prompt (strcat
		    "\nboundary (bounding box) polyline:\n"
		    "  X: "
		    (rtos minx 2 2)
		    " ... "
		    (rtos maxx 2 2)
		    "\n  Y: "
		    (rtos miny 2 2)
		    " ... "
		    (rtos maxy 2 2)
		  )
	  )

	  ;; 5) Building a grid "in a staggered manner"
	  (setq	row 0
		y   miny
		circulos 0
	  )
	  (setq osmant (getvar "osmode"))
	  (setvar "osmode" 0)
	  (while (<= y maxy)
	    ;; For an odd row row, we shift X by step/2
	    (if	(oddp row)
	      (setq x (+ minx (/ step 2.0)))
	      (setq x minx)
	    )

	    (while (<= x maxx)
	      (setq pt (list x y))
	      ;; If the center is inside the polyline, draw a circle.
	      (if (comprobar_centralidad pt vlist)
					;(pointInPolygon pt vlist)
		(progn
		  (command "_.CIRCLE" pt radius)
		  (setq circulos (+ circulos 1))
		)
	      )
	      (setq x (+ x step))
	    )
	    (setq y (+ y step))
	    (setq row (1+ row))
	  )
	  (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)..."))
;;;	    (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0))
	    (creaMTEXT (strcat "Count:\\P" (itoa (sslength conj))) (/ radius 2.0))
	  )
	  (setvar "osmode" osmant)
	)
      )
    )
  )
  (princ)
)


(defun c:WP-count (/ pl lstent points conj ptx creaMTEXT altura)
  (defun creaMTEXT (texto altura / vlaEnt)
    (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" (itoa (sslength conj)))))
    (vlax-put-property vlaEnt "Height" altura)
  )
  (if (setq pl (car (entsel "\nSelect border polyline...")))
    (if (= "LWPOLYLINE" (cdr (assoc 0 (setq lstent (entget pl)))))
      (setq points (mapcar
		     'cdr
		     (vl-remove-if-not
		       '(lambda (x) (= (car x) 10))
		       lstent
		     )
		   )
      )
    )
  )
  (if points
    (progn
      (if (not altura1)
        (setq altura (getreal "\nHeight MTEXT: "))
        (setq altura (getreal (strcat "\nHeight MTEXT (or ENTER for <" (rtos altura1 2 2) ">): ")))
      )
      (if (not altura)
        (if altura1
          (setq altura altura1)
        )
	(setq altura1 altura)
      )
    )
  )
	  
  (if (and points altura (setq conj (ssget "_wp" points '((0 . "CIRCLE")))))
    (if (setq ptx (getpoint (strcat "\nPick insertion point for objects number text <" (itoa (sslength conj)) "> (right click or ENTER for skip)...")))
;;;      (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Count: " (itoa (sslength conj))) (VLAX-3D-POINT ptx) (/ radius 2.0))
      (creaMTEXT (strcat "Count:\\P" (itoa (sslength conj))) altura)
    )
  )
  (princ)
)

 

  • Thanks 1
Posted

In the main function I have predefined the height of the MTEXT to half the radius of the circles. If you want to modify it you will have to go into the code and change it.

I have also written a separate command.

I hope it helps.

  • Thanks 1
Posted (edited)

Im sorry

I forgot to change something in the main command
I attach the correction below

 

 

(defun c:Circles_Chess_outl (/	    oddp   ent	  step	 radius	vlist
			     minx   miny   maxx	  maxy	 x	y
			     row    pt	   osmant circulos    creaMTEXT
			    )
  ;;-----------------------------------------------
  ;; THE FUNCTION OF CHECKING WHETHER THE NUMBER IS ODD
  ;;-----------------------------------------------
  (defun oddp (n)
    (= (logand (fix n) 1) 1)
  )

  ;;-----------------------------------------------
  ;; Local auxiliary functions
  ;;-----------------------------------------------

  ;; Extracting a list of vertices (points) of a linear 2D polyline:
  (defun getPolyVertices (e / ed lst pts)
    (setq ed  (entget e)
	  ;; selecting all groups of the DXF = 10 code (coordinates of the vertices)
	  lst (vl-remove-if-not
		'(lambda (x) (= (car x) 10))
		ed
	      )
	  ;; turning them into a regular list of points (x y)
	  pts (mapcar 'cdr lst)
    )
    pts
  )

  ;; Checking whether the pt point is located inside the linear polygon v list:
;;;  (defun pointInPolygon (pt vlist / cnt i v1 v2)
;;;    (setq cnt 0
;;;          i   0
;;;    )
;;;    ;; "Let's "block" the list so that we can bypass the pair (list[i], list[i+1]):
;;;    (setq vlist (append vlist (list (car vlist))))
;;;    (repeat (1- (length vlist))
;;;      (setq v1 (nth i vlist)
;;;            v2 (nth (1+ i) vlist)
;;;            i  (1+ i)
;;;      )
;;;      (if (edgeIntersectsRay pt v1 v2)
;;;        (setq cnt (1+ cnt))
;;;      )
;;;    )
;;;    ;; If the number of intersections with the ray is odd, the point inside
;;;    (if (= (logand cnt 1) 1)
;;;      T
;;;      nil
;;;    )
;;;  )

  (defun comprobar_centralidad (pto	     lst_ptos_rto /
				pt_inters+   pt_inters-	  n
				pt1	     pt2	  inters_negat
				inters_posit
			       )
    (setq n 0)
    (repeat (- (length lst_ptos_rto) 1)
      (setq pt_inters+
	     (inters pto
		     (list (+ (car pto) 100000) (cadr pto))
		     (setq pt1 (nth n lst_ptos_rto))
		     (setq pt2 (nth (+ n 1) lst_ptos_rto))
	     )
      )

      (if (and pt_inters+
	       (not (member (cons 10 pt_inters+) lst_ptos_rto))
	  )
	(if inters_posit
	  (setq inters_posit (+ inters_posit 1))
	  (setq inters_posit 1)
	)
      )

      (setq pt_inters-
	     (inters pto
		     (list (- (car pto) 100000) (cadr pto))
		     pt1
		     pt2
	     )
      )
      (if (and pt_inters-
	       (not (member (cons 10 pt_inters-) lst_ptos_rto))
	  )
	(if inters_negat
	  (setq inters_negat (+ inters_negat 1))
	  (setq inters_negat 1)
	)
      )
      (setq n (+ n 1))
    )
    (if	(and (=	(rem (if (not inters_negat)
		       0
		       inters_negat
		     )
		     2
		)
		0
	     )
	     (=	(rem (if (not inters_posit)
		       0
		       inters_posit
		     )
		     2
		)
		0
	     )
	)
      nil
      T
    )
  )

  (defun creaMTEXT (texto altura / vlaEnt)
    (setq vlaEnt (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point ptx) 50 (strcat "Count:\\P" texto)))
    (vlax-put-property vlaEnt "Height" altura)
  )

  ;; Checking the intersection of the horizontal ray to the right of pt with the segment (v1,v2):
  (defun edgeIntersectsRay (pt v1 v2 / px py x1 y1 x2 y2)
    (setq px (car pt)
	  py (cadr pt)
	  x1 (car v1)
	  y1 (cadr v1)
	  x2 (car v2)
	  y2 (cadr v2)
    )
    ;; Let's ensure that (x1,y1) is "lower" than (x2,y2):
    (if	(> y1 y2)
      (progn
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Intersection condition:
    (and
      ;; 1) py is strictly above the lower vertex and not higher than the upper one
      (> py y1)
      (<= py y2)
      ;; 2) px < abscissas of the intersection point of the ray with the segment


      (defun edgeIntersectsRay
	     (pt v1 v2 / px py x1 y1 x2 y2 intersectX)
	(setq px (car pt)
	      py (cadr pt)
	      x1 (car v1)
	      y1 (cadr v1)
	      x2 (car v2)
	      y2 (cadr v2)
	)
      )
      ;; Let's ensure that (x1,y1) is "lower" than (x2,y2)
      (if (> y1 y2)
	(setq x1 (car v2)
	      y1 (cadr v2)
	      x2 (car v1)
	      y2 (cadr v1)
	)
      )
    )
    ;; Counting the intersection coordinate
    (setq intersectX
	   (if (/= y2 y1)
	     (+ x1 (* (- py y1) (/ (- x2 x1) (- y2 y1))))
	     x1
	     ;; if the segment is horizontal, it is usually skipped.
	   )
    )
    ;; We are returning (and ...), or nil
    (and
      (> py y1)
      ;; a point above the lower vertex
      (<= py y2)
      ;; and no higher than the top
      (> intersectX px)
    )
  )
  ;;-----------------------------------------------
  ;; the main part
  ;;-----------------------------------------------
  (setq ent (car (entsel "\nChoose a closed linear polyline: ")))

  (if (null ent)
    (progn
      (prompt "\nThe polyline is not selected. Completion.")
      (princ)
    )
    (progn
      ;; 1) Step Request
      (setq
	step (getreal "\nEnter the step between the centers (??): ")
      )
      (if (or (null step) (<= step 0.0))
	(setq step 50.0)
	;; the "backup" option
      )

      ;; 2) Fixed radius
      (setq radius 25.0)

      ;; 3) List of vertices (minimum 3, otherwise not a polygon)
      (setq vlist (getPolyVertices ent))
      (if (< (length vlist) 3)
	(progn
	  (prompt
	    "\nThe polyline has <3 vertices, and the contour is incorrect."
	  )
	  (princ)
	)
	(progn
	  ;; 4) Defining bounding box
	  (setq	minx (apply 'min (mapcar 'car vlist))
		maxx (apply 'max (mapcar 'car vlist))
		miny (apply 'min (mapcar 'cadr vlist))
		maxy (apply 'max (mapcar 'cadr vlist))
	  )
	  (prompt (strcat
		    "\nboundary (bounding box) polyline:\n"
		    "  X: "
		    (rtos minx 2 2)
		    " ... "
		    (rtos maxx 2 2)
		    "\n  Y: "
		    (rtos miny 2 2)
		    " ... "
		    (rtos maxy 2 2)
		  )
	  )

	  ;; 5) Building a grid "in a staggered manner"
	  (setq	row 0
		y   miny
		circulos 0
	  )
	  (setq osmant (getvar "osmode"))
	  (setvar "osmode" 0)
	  (while (<= y maxy)
	    ;; For an odd row row, we shift X by step/2
	    (if	(oddp row)
	      (setq x (+ minx (/ step 2.0)))
	      (setq x minx)
	    )

	    (while (<= x maxx)
	      (setq pt (list x y))
	      ;; If the center is inside the polyline, draw a circle.
	      (if (comprobar_centralidad pt vlist)
					;(pointInPolygon pt vlist)
		(progn
		  (command "_.CIRCLE" pt radius)
		  (setq circulos (+ circulos 1))
		)
	      )
	      (setq x (+ x step))
	    )
	    (setq y (+ y step))
	    (setq row (1+ row))
	  )
	  (if (setq ptx (getpoint "\nPick insertion point for circle number text (right click or ENTER for skip)..."))
;;;	    (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (strcat "Number of circles drawn: " (itoa circulos)) (VLAX-3D-POINT ptx) (/ radius 2.0))
	    (creaMTEXT (strcat "Count:\\P" (itoa circulos)) (/ radius 2.0))
	  )
	  (setvar "osmode" osmant)
	)
      )
    )
  )
  (princ)
)

 

Edited by GLAVCVS
  • Like 1
Posted (edited)
29 minutes ago, GLAVCVS said:

In the main function I have predefined the height of the MTEXT to half the radius of the circles. If you want to modify it you will have to go into the code and change it.

I have also written a separate command.

I hope it helps.

Thank, but unfortunately, it doesn't work.

The text with the number of circles in the contour is not inserted into the drawing.
Pick insertion point for circle number text (right click or ENTER for skip)...
; error: invalid argument type: lselsetp nil

I need a fixed text height if possible... Mtext is not needed...

This WP-count-txt code is suitable for me...

I just want to insert a text with the number of circles in the outline into the drawing.

But how do I add it correctly?

Edited by Nikon
Posted

I've edited the last code.
Now it will work

  • Thanks 1
Posted

There is also another detail:
in the command 'c:WP-count' you must change the selection mode from ' ssget "_wp" ' to ' ssget "_cp" ' so that it selects not only the objects that are fully included

  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...