请教老师，如何获取嵌套块的插入点坐标数据？
本帖最后由 mice6672 于 2024-10-26 21:45 编辑图框是块，图框里面的标题栏是嵌套块，请教各位老师，如何获取嵌套块的插入点坐标数据？请指教，谢谢。
(setq ss (ssget (list '(0 . "INSERT") '(2 . "ECTK_*") (cons 8 "Y-云图图框"))))
(setq n (sslength ss))(setq name (ssname ss 0))
(setq dxf (entget name))
(setq tmx (car(RefGeom (ssname ss 0))));返回值((100.0 0.0 0.0) (0.0 100.0 0.0) (0.0 0.0 100.0))
(setq sname (cdr (Assoc 2 dxf)))
(setq e(tblobjname "block" sname))
(while
e
(setq e(entnext e))
(setq dxf(entget e))
(wcmatch(cdr(assoc 0 dxf)) "INSERT")
(setq blk2(cdr(assoc 2 dxf)))
(if (= "SJY_标题栏" blk2)(progn(setq btl_p0 (cdr (assoc 10 dxf)) e nil)));返回值btl_p0=(584.0 10.0 0.0)
)
(setq btl_p1 (MCS2WCS tmx btl_p0));;此处出错，没有值
以下为 highflybir 老师 http://bbs.mjtd.com/forum.php?mo ... 3216&fromuid=288402
;;; 矢量的点积
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)(apply '+ (mapcar '* v1 v2)))
;;; 矢量转置
;;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)(apply 'mapcar (cons 'list m)))
;;; 矢量的矩阵变换
;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)(mapcar (function (lambda (r) (vxv r v))) m))
;;; 点到矩阵的变换
(defun mxp (m p)(reverse (cdr (reverse (mxv m (append p '(1.0)))))))
;;; 矩阵相乘
;;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)(mapcar (function (lambda (r) (mxv (trp q) r))) m))
;; TransNested (gile)
;; Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
;; reference (xref or block) whatever its nested level-
;; Arguments
;; pt : the point to translate
;; rlst : the parents entities list from the deepest nested to the one inserted in
;; current space -same as (last (nentsel)) or (last (nentselp))
;; from to : as with trans function: 0 for WCS, 1 for current UCS, 2 for RCS
(defun TransNested (pt rlst from to / geom)
(and (= 1 from) (setq pt (trans pt 1 0)))
(and (= 2 to) (setq rlst (reverse rlst)))
(and (or (= 2 from) (= 2 to))
(while rlst
(setq geom (if (= 2 to)
(RevRefGeom (car rlst))
(RefGeom (car rlst))
)
rlst (cdr rlst)
pt (mapcar '+ (mxv (car geom) pt) (cadr geom))
)
)
)
(if (= 1 to)
(trans pt 0 1)
pt
)
)
;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, bloc or space)
;;
;; Argument : an ename
(defun RefGeom (ename / elst ang norm mat u v w A B)
(setq elst (entget ename)
ang(cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(setq u (cdr (assoc 41 elst)))
(setq v (cdr (assoc 42 elst)))
(setq w (cdr (assoc 43 elst)))
(setq A (cos ang))
(setq B (sin ang))
(list
(setq mat
(mxm
(mapcar (function (lambda (v) (trans v 0 norm T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(list (list (* u A) (- (* v B)) 0.0)
(list (* u B) (* v A) 0.0)
(list 0.0 0.0 w)
)
)
)
(mapcar
'-
(trans (cdr (assoc 10 elst)) norm 0)
(mxv mat
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
)
)
)
)
;; RevRefGeom (gile)
;; RefGeom inverse function
(defun RevRefGeom (ename / entData ang norm mat)
(setq entData (entget ename)
ang (- (cdr (assoc 50 entData)))
norm (cdr (assoc 210 entData))
)
(list
(setq mat
(mxm
(list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v norm 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
)
(mapcar '-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
(mxv mat (trans (cdr (assoc 10 entData)) norm 0))
)
)
)
以下为 龙龙仔 老师
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=7496
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))
)
)
)
)
没看到图呢 dwg呢 没必要搞那么复杂，临时把图框图块炸掉，找到标题栏图块，获取坐标，然后UNDO (vl-load-com)
(setq ty (car (entsel)))
(setq ent (entget ty))
(setq blk_name (cdr (assoc 2 ent)))
(setq pt1 (cdr (assoc 10 ent)))
(setq bili (cdr (assoc 41 ent)))
(vlax-for item (vlax-invoke-method (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) 'Item blk_name)
(if (and
(= (vla-get-ObjectName item) "AcDbBlockReference")
(= (vla-get-EffectiveName item) "SJY_标题栏")
)
(progn
(setq pt2 (cdr (assoc 10 (entget (vlax-vla-object->ename item)))))
(setq pt3 (mapcar '+ pt1 (mapcar '* pt2 (list bili bili 0))))
(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 1)(cons 10 pt3)(cons 40 (* bili 3))))
)
)
) (setq ty(car(entsel)))
(setq dxf (entget ty))
(setq sname (cdr (assoc 2 dxf)))
(setq pt1 (cdr (assoc 10 dxf)))
(setq bili (cdr (assoc 41 dxf)))
(setq e(tblobjname "block" sname))
(while e
(setq e(entnext e))
(setq dxf(entget e))
(setq blk2(cdr(assoc 2 dxf)))
(if (= "SJY_标题栏" blk2)
(progn
(setq btl_p0 (cdr (assoc 10 dxf)) e nil)
(setq pt3 (mapcar '+ pt1 (mapcar '* btl_p0 (list bili bili 0))))
(entmake (list '(0 . "CIRCLE")'(100 . "AcDbEntity")'(100 . "AcDbCircle")(cons 62 1)(cons 10 pt3)(cons 40 (* bili 3))))
)
)
)
(princ) 飞雪神光 发表于 2024-10-26 22:46
非常感谢。学习了 kozmosovia 发表于 2024-10-26 21:57
没必要搞那么复杂，临时把图框图块炸掉，找到标题栏图块，获取坐标，然后UNDO
这也是一种思路，学习了
页:
[1]