[编程交流] 获取实体i的点

(setq ptz (cdr (assoc 10 (entget (cadr (getblkitems ent))))))

(defun blockreferencecirclecenter ( ref / cen ent enx )
   (setq ent (tblobjname "block" (cdr (assoc 2 (entget ref)))))
   (while
       (and
           (null cen)
           (setq ent (entnext ent))
           (setq enx (entget  ent))
       )
       (if (= "CIRCLE" (cdr (assoc 0 enx)))
           (setq cen (trans (cdr (assoc 10 enx)) (cdr (assoc 210 enx)) 0))
       )
   )
   (if cen (apply '(lambda ( mat vec ) (mapcar '+ (mxv mat cen) vec)) (refgeom ref)))
)
;; 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)
)

(defun c:test ( / cen ent )
   (if (setq ent (car (entsel)))
       (if (= "INSERT" (cdr (assoc 0 (entget ent))))
           (if (setq cen (blockreferencecirclecenter ent))
               (entmake (list '(0 . "POINT") (cons 10 cen) (cons 210 (trans '(0 0 1) 1 0 t))))
               (princ "\nNo circle found in block definition.")
           )
           (princ "\nObject is not a block.")
       )
       (princ "\nNo object selected.")
   )
   (princ)
)

(defun c:tt (/)
 (setq pOCS '(1.11 2.22 3.33))  ; coordinates in Object Cor. Sys
 (setq M (cadr (cdr (nentsel)) )) ; block 4 x 3 matrix
 (setq pWCS (transform pOCS M)) ; coordinates in WCS
 (princ pwcs)
 (princ)
)
(defun transform (a HTM / transpt)        ;Coordinate transformation via matrix multiplication
                                ; a = point (3 coordinates)
                                ; HTM = homogeneous transformation matrix (3 x 4)
 (setq aH (append a '(1.0)))                ; aH = homogeneous point in local coordinates (1 x 4)
 (setq        transpt
 (list
   (+                                ; transpt = list of x, y, z coordinates
     (* (nth 0 aH) (nth 0 (nth 0 HTM)))
     (* (nth 1 aH) (nth 0 (nth 1 HTM)))
     (* (nth 2 aH) (nth 0 (nth 2 HTM)))
     (* (nth 3 aH) (nth 0 (nth 3 HTM)))
   )
   (+
     (* (nth 0 aH) (nth 1 (nth 0 HTM)))
     (* (nth 1 aH) (nth 1 (nth 1 HTM)))
     (* (nth 2 aH) (nth 1 (nth 2 HTM)))
     (* (nth 3 aH) (nth 1 (nth 3 HTM)))
   )
   (+
     (* (nth 0 aH) (nth 2 (nth 0 HTM)))
     (* (nth 1 aH) (nth 2 (nth 1 HTM)))
     (* (nth 2 aH) (nth 2 (nth 2 HTM)))
     (* (nth 3 aH) (nth 2 (nth 3 HTM)))
   )
 )
 )
 (setq transpt (list (nth 0 transpt) (nth 1 transpt) (nth 2 transpt)))
)                                        ;end transform 

(defun c:test ( / ent sel lst)
   (if (and (cdddr (setq sel (nentselp)))
            (= "CIRCLE" (cdr (assoc 0 (setq lst (entget (car sel))))))
            (setq ent (entmakex (list '(0 . "POINT") (cons 10 (trans (cdr (assoc 10 lst)) (cdr (assoc 210 lst)) 0)) (cons 210 (trans '(0 0 1) 1 0 t)))))
       )
       (progn
           (vla-transformby (vlax-ename->vla-object ent) (vlax-tmatrix (caddr sel)))
           (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)
       )
   )
   (princ)
)

(foo BlockReference PtInsideBlkDef) -> PtInWCS

(foo BlockReference PtListInsideBlkDef) -> PtListInWCS

(foo BlockReferenceA (foo BlockReferenceB (foo BlockReferenceC PtListInsideBlkDef)))