Jump to content

Recommended Posts

Posted
19 minutes ago, GLAVCVS said:
I've edited the last code.


t will work

For some reason, it inserts text in this form...

10.png

Posted

For the text content and its size you will have to edit the code yourself

  • Agree 1
Posted (edited)
4 minutes ago, Nikon said:

Por alguna razón, inserta texto en este formato...

10.png

 

Please copy the code again
It should write only the number in a single line text

 

Edited by GLAVCVS
  • Thanks 1
Posted

Wait
I just noticed that for some reason the website didn't update my edited code.

I'll attach it again

  • Thanks 1
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 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))) (itoa circulos) (VLAX-3D-POINT ptx) (/ radius 2.0))
;;;	    (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)
)

 

  • Thanks 1
Posted
27 minutes ago, GLAVCVS said:

Wait
I just noticed that for some reason the website didn't update my edited code.

I'll attach it again

Yes, everything is fine now! Thank you so much for your help! Dreams come true... 🎇

  • Like 1
Posted

 

One last thing: Steven is right. It's better not to use 'command'. The code runs slower and is vulnerable to the state of the "osmode" system variable.

That's why I've updated your code so that the circles are generated faster.

 

(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 texto))
    (vlax-put-property vlaEnt "Height" altura)
  )
  (defun creaCIRCULO (pto radio / vlaEnt)
    (setq vlaEnt (vla-AddCircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pto) radio))
  )

  ;; 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)
		  (creaCIRCULO 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))) (itoa circulos) (VLAX-3D-POINT ptx) (/ radius 2.0))
;;;	    (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)
)

 

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

One last thing: Steven is right. It's better not to use 'command'. The code runs slower and is vulnerable to the state of the "osmode" system variable.

That's why I've updated your code so that the circles are generated faster.

Thanks, the circles are really drawn much faster.
I tested the code at work in autocad 2020 and the irregular contours were also filled with circles in a checkerboard pattern.
When I run the command in autocad 2015, only the rectangular contours are filled in.
If you select polygons, the code returns an error:
The polyline has vertices, and the contour is incorrect.
Is this a problem with the code or with the autocad, I don't understand...

 

contour.png

Edited by Nikon
Posted (edited)

The problem is in the 'getPolyVertices' function.
When it comes to a closed polyline, it does not add the final closing point. For this reason, 'comprobar_centralidad' does not work correctly.
Adjust the function as I show you in the image

 

 

 

Img1-2.png

Edited by GLAVCVS
  • Thanks 1
Posted (edited)
34 minutes ago, GLAVCVS said:

The problem is in the 'getPolyVertices' function.


When it comes to a closed polyline, it does not add the final closing point. For this reason, 'comprobar_centralidad' does not work correctly.
Adjust the function as I show you in the image

Thanks, I'll try...
Which line in the code is responsible for counting the number of circles depending on CP and WP?

CP and WP.png

Edited by Nikon
Posted
1 hour ago, GLAVCVS said:

The problem is in the 'getPolyVertices' function.
When it comes to a closed polyline, it does not add the final closing point. For this reason, 'comprobar_centralidad' does not work correctly.
Adjust the function as I show you in the image

I'm replacing this

;; turning them into a regular list of points (x y)
      pts (mapcar 'cdr lst)
    )
    pts
  )

with
 ;; turning them into a regular list of points (x y)
pts (mapcar 'cdr lst)
)
 (if (vlax-get-property (vlax-ename->vla-object e) "Closed")
(append pts (list (car pts)))
pts
)
)

But nothing changes, the error remains....

 

 

Posted (edited)
(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)
    )
    (if (= (vlax-get-property (vlax-ename->vla-object e) "Closed") ':vlax-true) 
      (append pts (list (car pts)))
      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 texto))
    (vlax-put-property vlaEnt "Height" altura)
  )
  (defun creaCIRCULO (pto radio / vlaEnt)
    (setq vlaEnt (vla-AddCircle (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pto) radio))
  )

  ;; 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)
		  (creaCIRCULO 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))) (itoa circulos) (VLAX-3D-POINT ptx) radius)
;;;	    (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)
)


(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 TEXT: "))
        (setq altura (getreal (strcat "\nHeight TEXT (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 "_cp" 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))) (itoa (sslength conj)) (VLAX-3D-POINT ptx) altura)
    )
  )
  (princ)
)

 

Edited by GLAVCVS
  • Thanks 1
Posted

I just updated the code with the necessary changes.

Please check if everything is working properly

  • Thanks 1
Posted

For some reason, the code in Autocad 2015 does not work with polygons, only with rectangles.
I'll check the code in Autocad 2020 tomorrow.

Posted

Wait

I don't know what's going on

I edited the code but the website hasn't updated it again

I'll try again.

  • Thanks 1
Posted (edited)

That's it. Now it works.

The code should work in AutoCAD 2015. I've tested it and it works.

Edited by GLAVCVS
  • Like 1
Posted (edited)
10 hours ago, GLAVCVS said:

That's it. Now it works.

The code should work in AutoCAD 2015. I've tested it and it works.

Thank you very much, you helped me a lot!
In Autocad 2020, it works with all complex contours.
I'll be able to check on Autocad 2015 in the evening.

Edited by Nikon
Posted

But I want to repeat the question about counting circles inside a contour (WP).

Simply replacing the cp with the wp does not do anything.

(if (and points altura (setq conj (ssget "_cp" points '((0 . "CIRCLE")))))

 (if (and points altura (setq conj (ssget "_wp" points '((0 . "CIRCLE")))))

How can this be changed?

Posted

I didn't notice right away, but the chess order is wrong.
How can this be changed?

the chess order is wrong.png

Posted (edited)

In the last code I have attached last time are the 2 updated commands.
Copy them again and test them to make sure what you tell me.

In 'WP-count' the selection mode is updated and works correctly. If you want to customize the text content you will have to modify the parameter '(itoa (sslenght conj))' of the function '(vla-AddText...) '

 

As for the pattern, so that the distribution of the circles is square and not rhomboidal, simply divide by 2 the parameter 'step' when the 'y' of the loop '(while (<= y maxy) ' is increased. 

 

'(setq y (+ y (/ step 2.0)))'

Edited by GLAVCVS
  • 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...