Copy blk to centoid pline.

[Anonymous]

Hi all,

i want to copy block to all centoid rectang, so i writed this code. But it is not run. Can someone fix it. Thanks.

(defun c:test (/ blk ename cen p_blk ar ar1 n ss)

(if (setq blk (car (entsel "\nSelect block: ")))
(progn
(if
(setq
ename (entsel
"\nSelect object: "
)
)
(progn
(setq p_blk (vlax-get (vlax-ename->vla-object blk) 'InsertionPoint)
)
(setq ar
(vlax-get (vlax-ename->vla-object (car ename)) 'area)
)
(print (list (assoc 0 (entget (car circle))) (assoc 8 (entget (car ename)))))
(setq ss (ssget "_X"
(list (assoc 0 (entget (car ename)))
(assoc 8 (entget (car ename)))
)
)
)

(setq n 0)
(repeat (sslength ss)
(setq cen (LM:PolyCentroid (ssname ss n)))
(setq ar1 (vlax-get (vlax-ename->vla-object (ssname ss n)) 'area)
)

(if (= ar ar1)
(progn
(command "_.copy" blk "" "_NONE" p_blk "_NONE" cen)
);progn then
) ;if
(setq n (+ n 1))
) ;repeat
) ;progn then
) ;if
) ;progn
) ;if
(princ)
) ;defun

;; Polygon Centroid - Lee Mac
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM:PolyCentroid (e / l)
(foreach x (setq e (entget e))
(if (= 10 (car x))
(setq l (cons (cdr x) l))
)
)
(
(lambda (a)
(if (not (equal 0.0 a 1e-8))
(trans
(mapcar
'/
(apply
'mapcar
(cons '+
(mapcar
(function
(lambda (a b)
(
(lambda (m)
(mapcar
(function
(lambda (c d) (* (+ c d) m))
)
a
b
)
)
(- (* (car a) (cadr b)) (* (car b) (cadr a)))
)
)
)
l
(cons (last l) l)
)
)
)
(list a a)
)
(cdr (assoc 210 e))
0
)
)
)
(* 3.0
(apply '+
(mapcar
(function
(lambda (a b)
(- (* (car a) (cadr b)) (* (car b) (cadr a)))
)
)
l
(cons (last l) l)
)
)
)
)
)

[ВeekeeCZ · Accepted solution]

Comment out your test line where variable named circle does not exist.

;(print (list (assoc 0 (entget (car circle))) (assoc 8 (entget (car ename)))))

Your area comparison often fails, add some reasonable precision.

(equal ar ar1 1e-4)

[Anonymous]

uhm, exactly.

Thank you so much BeekeeCZ

[devitg]

As your polys are rectangle , please try it . 

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2016 by Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM    


(DEFUN GET-BLOCK  ()
  (IF (AND (SETQ BLK (CAR (ENTSEL "\nSelect block: ")))
           (= (CDR (ASSOC 0 (ENTGET BLK))) "INSERT"))
    (PROGN
      (SETQ BLK-OBJ (VLAX-ENAME->VLA-OBJECT BLK))

      ) ;-progn if block
    (PROGN
      (ALERT "\nSelect block: ")
      (GET-BLOCK)
      ) ;- Progn if not blk 
    ) ;- if
  ) ;_ defun get-block
;;*************************************************************


(DEFUN GET-POLYS  ()
  (IF (AND (SETQ POLY (CAR (ENTSEL "\nSelect sample poly: ")))
           (= (CDR (ASSOC 0 (ENTGET POLY)))
              "LWPOLYLINE"
              ))

    (PROGN (SETQ SS (SSGET "_X"
                           (LIST (ASSOC 0 (ENTGET POLY))
                                 (ASSOC 8 (ENTGET POLY))
                                 ) ;_list
                           )
                    ;;ssget
                 ) ;ss
           ) ; progn

    (PROGN
      (ALERT "\nSelect poly : ")
      (GET-POLYS)
      ) ;- Progn if not poly
    ) ;- if
  ) ;_ defun get-polys
  
 ;;*************************************************************
 



(DEFUN C:BL-PL  (/ BLK ENAME CEN P_BLK AR AR1 N SS)

  (VL-LOAD-COM)
  (SETQ BLK-OBJ (GET-BLOCK))
  (SETQ P-BLK (VLAX-GET BLK-OBJ 'INSERTIONPOINT))
  (SETQ SS (GET-POLYS))

  (SETQ N 0)
  (REPEAT (SSLENGTH SS)
    (SETQ RECTANG-OBJ (VLAX-ENAME->VLA-OBJECT (SSNAME SS N)))
    (VLA-GETBOUNDINGBOX RECTANG-OBJ 'DL 'UR)
    (SETQ DL-XYZ (SAFEARRAY-VALUE DL))
    (SETQ UR-XYZ (SAFEARRAY-VALUE UR))
    (SETQ MIDPOINT (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ DL-XYZ UR-XYZ)))
    (SETQ NEW-BLOCK (VLA-COPY BLK-OBJ))
    (VLA-MOVE NEW-BLOCK (VLAX-3D-POINT P-BLK) (VLAX-3D-POINT MIDPOINT))
    (SETQ N (1+ N))
    ) ;_repeat
  ) ;_ defun bl-pl                   
                          
  
  
;|«Visual LISP© Format Options»
(180 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

[Anonymous]

okey,

thanks devitg.

But i still use my code. ^_^

[devitg]

It was just other way to do it . Did you try it? Work? 

[Anonymous]

yep, i tried. it work.

but in my code maybe use in another case pline > 4 vertex.

thanks for share, davitg

^_^