求助陈伯雄老师

王咣生

一个图块中有两个子实体(POLYLINE,CIRCLE),请问如何得到CIRCLE的圆心坐标.
（在不炸碎块的情况下）
子实体数据表:
((-1 . <图元名: 33b0528>) (0 . "CIRCLE") (5 . "25") (100 . "AcDbEntity") (67 .
0) (8 . "0") (100 . "AcDbCircle") (10 5.0 5.0 0.0) (40 . 2.0) (210 0.0 0.0 1.0))
其中(10 5.0 5.0 0.0) 不是当前块中圆的圆心

((-1 . <图元名: 33b0520>) (0 . "LWPOLYLINE") (5 . "24") (100 . "AcDbEntity")
(67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 .
0.0) (39 . 0.0) (10 0.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 10.0 0.0) (40
. 0.0) (41 . 0.0) (42 . 0.0) (10 10.0 10.0) (40 . 0.0) (41 . 0.0) (42 . 0.0)
(10 0.0 10.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))

陈伯雄

(Defun SBlock (slist / sname)
              (SetQ sname (Cdr (Assoc 2 slist))
                    slist (TblSearch "BLOCK" sname)
              )
              (SetQ etbll (Cons slist etbll)
                    sname (Cdr (Assoc -2 slist))
              )
              (While (SetQ etbll (Cons (EntGet sname) etbll)
                           sname (EntNext sname)
                     )
              )
       )

王咣生

我是用(TblSearch "BLOCK" sname)遍历"Block"中的每一个子实体,但对于一个圆子实体,用
entget函数得不到Circle在当前WCS下的圆心坐标.

陈伯雄

龙龙仔

This is pretty much straight from AutoLISP Programming... by Rawls & Hagen.
;;tmx: 4x4 transformation matrix from nentselp - (caddr (nentselp))
;;p: point to transform
(defun MCS2WCS (TMX P / WX WY WZ)
  (list
    (setq WX
           (+
             (* (car (nth 0 TMX)) (car P))
             (* (cadr (nth 0 TMX)) (cadr P))
             (* (caddr (nth 0 TMX)) (caddr P))
             (cadddr (nth 0 TMX))
           )
    )
    (setq WY
           (+
             (* (car (nth 1 TMX)) (car P))
             (* (cadr (nth 1 TMX)) (cadr P))
             (* (caddr (nth 1 TMX)) (caddr P))
             (cadddr (nth 1 TMX))
           )
    )
    (setq WZ
           (+
             (* (car (nth 2 TMX)) (car P))
             (* (cadr (nth 2 TMX)) (cadr P))
             (* (caddr (nth 2 TMX)) (caddr P))
             (cadddr (nth 2 TMX))
           )
    )
  )
)


;;使用例
(defun C:TT (/ WW TMX P)
  (setq WW (nentselp "\n点选图块中的圆"))
  (setq TMX (caddr WW))
  (setq P (cdr (assoc 10 (entget (car WW)))))
  (MCS2WCS TMX P)
)