[编程交流] 重心

(vlax-safearray->list(vlax-variant-value(vla-get-centroid vlaobject)))

(defun c:test ( / cen ent )
   (princ "\nSelect a block reference containing a solid: ")
   (if (setq ent (ssget "_+.:E:S" '((0 . "INSERT"))))
       (progn
           (setq ent (ssname ent 0))
           (vlax-for obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget ent))))
               (if (vlax-property-available-p obj 'centroid)
                   (setq cen (vlax-get obj 'centroid))
               )
           )
           (if cen
               (entmake
                   (list
                      '(0 . "POINT")
                       (cons 10 (apply '(lambda ( m v ) (mapcar '+ (mxv m cen) v)) (refgeom ent)))
                   )
               )
               (princ "\nNo block components found with Centroid property.")
           )
       )
   )
   (princ)
)
;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom ( ent / ang enx mat ocs )
   (setq enx (entget ent)
         ang (cdr (assoc 050 enx))
         ocs (cdr (assoc 210 enx))
   )
   (list
       (setq mat
           (mxm
               (mapcar '(lambda ( v ) (trans v 0 ocs t))
                  '(
                       (1.0 0.0 0.0)
                       (0.0 1.0 0.0)
                       (0.0 0.0 1.0)
                   )
               )
               (mxm
                   (list
                       (list (cos ang) (- (sin ang)) 0.0)
                       (list (sin ang) (cos ang)     0.0)
                      '(0.0 0.0 1.0)
                   )
                   (list
                       (list (cdr (assoc 41 enx)) 0.0 0.0)
                       (list 0.0 (cdr (assoc 42 enx)) 0.0)
                       (list 0.0 0.0 (cdr (assoc 43 enx)))
                   )
               )
           )
       )
       (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
           (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
       )
   )
)
;; 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)
)
(vl-load-com) (princ)