请教老师，如何获取嵌套块的插入点坐标数据？

mice6672 · 发表于 2024-10-26 20:33:29

本帖最后由 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))
         )
)
  )
)

飞雪神光 · 发表于 2024-10-26 21:25:46

没看到图呢 dwg呢

kozmosovia · 发表于 2024-10-26 21:57:43

没必要搞那么复杂，临时把图框图块炸掉，找到标题栏图块，获取坐标，然后UNDO

飞雪神光 · 发表于 2024-10-26 22:40:14

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

飞雪神光 · 发表于 2024-10-26 22:46:30

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

mice6672 · 发表于 2024-10-27 18:24:06

飞雪神光发表于 2024-10-26 22:46

非常感谢。学习了

mice6672 · 发表于 2024-10-27 18:27:00

kozmosovia 发表于 2024-10-26 21:57
没必要搞那么复杂，临时把图框图块炸掉，找到标题栏图块，获取坐标，然后UNDO

这也是一种思路，学习了

账号		自动登录	找回密码
密码			注册

[讨论] 请教老师，如何获取嵌套块的插入点坐标数据？

本帖子中包含更多资源