Insert Block on closed polyline by layer

[ramirez.m.1989]

Guys, I need your help.

I have created a certain amount of blocks and layers, and I need to insert a block in each closed polyline, depending on the layer of it.

If the polyline is in layer 1, you would have to insert block 1. If the polyline is in layer 2, you would have to insert block 2. So on.

There is a drawing with layer and example blocks in the attachment. The idea is to select all the closed polylines and automatically insert their respective block in the center of the polyline.

I hope I have explained well.

Thanks in advance.

[_gile]

Hi,

Here's a simple example which should work with AutoCAD 2016 and upper.

Anyway, it seems to me there's a problem with the base point of your blocks.

(defun c:BlockLayer (/ *error* attreq ss i pl)
  (defun *error* (msg)
    (and msg
	 (/= msg "Function cancelled")
	 (princ (strcat "\nError: " msg))
    )
    (setvar 'attreq attreq)
    (princ)
  )
  (setq attreq (getvar 'attreq))
  (setvar 'attreq 0)
  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1) (8 . "Layer_[A-D]"))))
    (repeat (setq i (sslength ss))
      (setq pl (entget (ssname ss (setq i (1- i)))))
      (command
	"_.insert"
	(substr (cdr (assoc 8 pl)) 7)
	"_gcen"
	(trans (cdr (assoc 10 pl)) (cdr (assoc 210 pl)) 1)
	1.0
	1.0
	0.0
      )
    )
  )
  (*error* nil)
)

[_gile]

For AutoCAD versions lower than 2016, we need to compute the polyline centroid (keep in mind the polyline centroid may be outside of the polyline).

(defun c:BlockLayer (/ *error* attreq ss i pl)
  (defun *error* (msg)
    (and msg
	 (/= msg "Function cancelled")
	 (princ (strcat "\nError: " msg))
    )
    (setvar 'attreq attreq)
    (princ)
  )
  (setq attreq (getvar 'attreq))
  (setvar 'attreq 0)
  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1) (8 . "Layer_[A-D]"))))
    (repeat (setq i (sslength ss))
      (setq pl (entget (ssname ss (setq i (1- i)))))
      (command
	"_.insert"
	(substr (cdr (assoc 8 pl)) 7)
	"-non"
	(trans (pline-centroid (cdr (assoc -1 pl))) 0 1)
	1.0
	1.0
	0.0
      )
    )
  )
  (*error* nil)
)

;; ALGEB-AREA (gile)
;; Returns tha algebraic area of the triangle defined by three 2d points
;; the area is negative if points are clockwise

(defun algeb-area (p1 p2 p3)
  (/ (-	(* (- (car p2) (car p1))
	   (- (cadr p3) (cadr p1))
	)
	(* (- (car p3) (car p1))
	   (- (cadr p2) (cadr p1))
	)
     )
     2.0
  )
)

;; TRIANGLE-CENTROID (gile)
;; Returns the centroid of a triangle defined by three points

(defun triangle-centroid (p1 p2 p3)
  (mapcar '(lambda (x1 x2 x3)
	     (/ (+ x1 x2 x3) 3.0)
	   )
	  p1
	  p2
	  p3
  )
)

;; POLYARC-CENTROID (gile)
;; Returns a list which first item is the centroid of a 'polyarc'
;; and the second its algeraic area
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-centroid	(bu p1 p2 / ang rad cen area dist cg)
  (setq	ang  (* 2 (atan bu))
	rad  (/	(distance p1 p2)
		(* 2 (sin ang))
	     )
	cen  (polar p1
		    (+ (angle p1 p2) (- (/ pi 2) ang))
		    rad
	     )
	area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
	dist (/ (expt (distance p1 p2) 3) (* 12 area))
	cg   (polar cen
		    (- (angle p1 p2) (/ pi 2))
		    dist
	     )
  )
  (list cg area)
)

;; PLINE-CENTROID (gile)
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

(defun pline-centroid (pl / elst lst tot cen p0 area cen)
  (setq elst (entget pl))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst (reverse lst)
	tot 0.0
	cen '(0.0 0.0)
	p0  (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
	  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
	  tot (cadr p-c)
    )
  )
  (setq lst (cdr lst))
  (if (equal (car (last lst)) p0 1e-9)
    (setq lst (reverse (cdr (reverse lst))))
  )
  (while (cadr lst)
    (setq area (algeb-area p0 (caar lst) (caadr lst))
	  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
		       cen
		       (triangle-centroid p0 (caar lst) (caadr lst))
	       )
	  tot  (+ area tot)
    )
    (if	(/= 0 (cdar lst))
      (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))
	    cen	(mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
			cen
			(car p-c)
		)
	    tot	(+ tot (cadr p-c))
      )
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
	  cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
		      cen
		      (car p-c)
	      )
	  tot (+ tot (cadr p-c))
    )
  )
  (trans (list (/ (car cen) tot)
	       (/ (cadr cen) tot)
	       (cdr (assoc 38 (entget pl)))
	)
	pl
	0
  )
)

[ramirez.m.1989]

It works well.

But I have two questions.

1. You can change the name of the layers to "AC HC" "AC SAND" "AC TIL" "AC BALD"?

2. Can you select the polylines in which you want to apply the routine? Because it is being applied in all the visible ones.

I attach example drawing 2.

Thanks.

[_gile · Accepted solution]

AutoCAD 2016+

(defun c:BlockLayer (/ *error* attreq ss i pl)
  (defun *error* (msg)
    (and msg
	 (/= msg "Function cancelled")
	 (princ (strcat "\nError: " msg))
    )
    (setvar 'attreq attreq)
    (princ)
  )
  (setq attreq (getvar 'attreq))
  (setvar 'attreq 0)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1) (8 . "Ac Bald,Ac Hc,Ac Sand,Ac Til"))))
    (repeat (setq i (sslength ss))
      (setq pl (entget (ssname ss (setq i (1- i)))))
      (command
	"_.insert"
	(cdr (assoc 8 pl))
	"_gcen"
	(trans (cdr (assoc 10 pl)) (cdr (assoc 210 pl)) 1)
	1.0
	1.0
	0.0
      )
    )
  )
  (*error* nil)
)

AutoCAD less than 2016

(defun c:BlockLayer (/ *error* attreq ss i pl)
  (defun *error* (msg)
    (and msg
	 (/= msg "Function cancelled")
	 (princ (strcat "\nError: " msg))
    )
    (setvar 'attreq attreq)
    (princ)
  )
  (setq attreq (getvar 'attreq))
  (setvar 'attreq 0)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1) (8 . "Ac Bald,Ac Hc,Ac Sand,Ac Til"))))
    (repeat (setq i (sslength ss))
      (setq pl (entget (ssname ss (setq i (1- i)))))
      (command
	"_.insert"
	(cdr (assoc 8 pl))
	"_non"
	(trans (pline-centroid (cdr (assoc -1 pl))) 0 1)
	1.0
	1.0
	0.0
      )
    )
  )
  (*error* nil)
)

[ramirez.m.1989]

Thanks, it works perfect.

[ramirez.m.1989]

Is it possible that the blocks inserted with attributes take the values ​​of width and length of each closed polyline?

Each polyline has its width and length dimension in a respective layer.

I attach example drawing 3.

Thanks.

[_gile]

What you ask for is possible and even more but I'm sorry, I usually come on this forum to try to help those who want to learn AutoLISP.
There it seems that, as and when the requests, you hope to obtain a specific development to measure, and I have neither the means nor the time to continue in this direction.
Maybe someone else can do it.

[ramirez.m.1989]

OK, no problem.

Thanks anyway