[编程交流] 块中的圆心

 (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))
         )

(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)
)

(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
)