center of circles in a block

[yajis_narif]

hiii

it's me again

i just have another problem i have created an array of circles then i used insert to get 4 blocks (array of circles ) in my drawing... now i want to get the center of each circle in each block

 (setq y (entget (cdr( assoc -2 (tblsearch "block" "AC" )))))
    (setq lis (length y))
(setq m 0)
(repeat lis
 (setq w (car (nth m y)))
     (if (= w 10)
     (progn 
       (setq center (cdr (nth m y)))
       ))
         (setq m (1+ m))
         )

this code gives me the center of the reference circle

i want to have the center of all circles

[Tharwat]

Is this what you mean ?

 

(defun c:test (/ ss)
 (if
   (and
     (entget (cdr (assoc -2 (tblsearch "block" "AC"))))
     (setq ss (ssget '((0 . "CIRCLE"))))
   )
    ((lambda (i / sset e)
       (while
         (setq sset (ssname ss (setq i (1+ i))))
          (setq e (entget sset))
          (command "_.-insert" "AC" (cdr (assoc 10 e)) "" "" "")
       )
     )
      -1
    )
    (princ)
 )
 (princ)
)

 

TharwaT

[yajis_narif]

Is this what you mean ?

 

(defun c:test (/ ss)
 (if
   (and
     (entget (cdr (assoc -2 (tblsearch "block" "AC"))))
     (setq ss (ssget '((0 . "CIRCLE"))))
   )
    ((lambda (i / sset e)
       (while
         (setq sset (ssname ss (setq i (1+ i))))
          (setq e (entget sset))
          (command "_.-insert" "AC" (cdr (assoc 10 e)) "" "" "")
       )
     )
      -1
    )
    (princ)
 )
 (princ)
)

TharwaT

 

your code asks me to select objects but my current drawing is 4 insert of the same block and my block is an array of circles so i want the center point of each circle in the block

[Tharwat]

So you have a block consist of four circles and you want to get the center point of each circle ?

[yajis_narif]

So you have a block consist of four circles and you want to get the center point of each circle ?

yes i want the center point of each circle when i use the tblsearch and the entget (assoc 10 ) it gives me the center of the reference circle of the array

drawing.dwg

[Lee Mac]

Try something like this:

 

(defun c:test ( / e mv ) (vl-load-com)
 (if
   (and
     (setq e
       (LM:Select "\nSelect Block: "
         (function
           (lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget x)))))
         )
         entsel
       )
     )
     (setq mv (LM:Def->Ref (vlax-ename->vla-object e)))
   )
   (
     (lambda ( ent )
       (while (setq ent (entnext ent))
         (if (eq "CIRCLE" (cdr (assoc 0 (entget ent))))
           (entmakex
             (list
               (cons 0 "POINT")
               (cons 10 (mapcar '+ (mxv (car mv) (cdr (assoc 10 (entget ent)))) (cadr mv)))
               (assoc 210 (entget e))
             )
           )
         )
       )
     )
     (tblobjname "BLOCK" (cdr (assoc 2 (entget e))))
   )
 )
 (princ)
)            

;;---------------=={ Block Def -> Block Ref }==---------------;;
;;                                                            ;;
;;  Returns the Transformation Matrix and Translation Vector  ;;
;;  for transforming Block Definition Geometry to a Block     ;;
;;  Reference.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  SourceBlock - VLA Block Reference Object                  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
;;------------------------------------------------------------;;

(defun LM:Def->Ref ( SourceBlock / norm ang x y z )

 (setq norm (vlax-get SourceBlock 'Normal)
        ang (vla-get-rotation SourceBlock))
     
 (mapcar
   (function
     (lambda ( sym prop alt )
       (set sym
         (vlax-get-property SourceBlock
           (if (vlax-property-available-p SourceBlock prop) prop alt)
         )
       )
     )
   )
  '(x                     y                     z                    )
  '(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
  '(XScaleFactor          YScaleFactor          ZScaleFactor         )
 )
 (
   (lambda ( m )
     (list m
       (mapcar '- (vlax-get SourceBlock 'InsertionPoint)
         (mxv m
           (cdr (assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock))))
         )
       )
     )
   )
   (mxm
     (mapcar
       (function
         (lambda ( e ) (trans e 0 norm t))
       )
      '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
     )
     (mxm
       (list
         (list (cos ang) (sin (- ang)) 0.)
         (list (sin ang) (cos ang)     0.)
         (list     0.        0.        1.)
       )
       (list
         (list x 0. 0.)
         (list 0. y 0.)
         (list 0. 0. z)
       )
     )
   )
 )
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
 (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
 ( (lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until a predicate function   ;;
;;  is validated                                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function taking ename argument  ;;
;;  func - selection function to invoke                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Select ( msg pred func / e ) (setq pred (eval pred))  
 (while
   (progn (setvar 'ERRNO 0) (setq e (car (func msg)))
     (cond
       ( (= 7 (getvar 'ERRNO))

         (princ "\n** Missed, Try again **")
       )
       ( (eq 'ENAME (type e))

         (if (and pred (not (pred e)))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 e
)

[yajis_narif]

thank you lee mac your programe is perfect it shows the center of each circle but one more thing can i get a list of the coordinate of each circle ??

[Lee Mac]

one more thing can i get a list of the coordinate of each circle ??

 

Yes, create a list using the point supplied to the entmake expression when creating the Point Entity.

[yajis_narif]

ok thank you so much Lee Mac i will try

[Lee Mac]

You're welcome - let me know if you get stuck

[yajis_narif]

ok i will thanks

right now i'm stuck in understanding the code it's kinda hard for me because i'm just a beginner in autolisp so i have no idea about all the V function in there