窗选获得INSERT、XREF内部分需要的实体

XDSoft

问题提出：论坛有朋友求助窗口选择INSERT或者XREF内的实体进行下一步处理，这个问题很有必要。


我准备了个图形，用XREF插入到图形中，请大家把红色多边形框内的BLOCK定义的实体中的数字文字实体名返回到一个表中，函数要求给个参数开关，是cross window还是 window,给个Fillter（同SSGET）参数，过滤指定的实体。(考虑UCS）

并利用上面写的函数，写个测试命令，把XREF在框内的数字文字实体“原位”的拷贝在图中。

测试图见附件

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:test8.rar 
下载次数:66  文件大小:113.45 KB 
下载权限: 不限 以上  [免费赚D豆]

ysq101

高手~~~~~支持分享~~~~~

userzhl

正想编个程序需要这个功能。{:soso_e100:}

Lispboy

研究了下老大的图，我的理解是：

要能得到框里面的实体，那么首先得把框的顶点变换到BLOCK坐标系下。一般情况下，BLOCK的坐标系等同于WCS。

1、获得UCS下点集
[pcode=lisp,true]
(setq pts (getpolyline_vertex (car (entsel))))
[/pcode]

1. 
   
2. 选择对象: ((45.9554 42.3574 0.0) (51.7666 46.6556 0.0) (49.8901 59.3423 0.0)
   
3. (53.1029 61.9866 0.0) (33.3132 64.8213 0.0) (22.702 51.5639 0.0) (30.0977
   
4. 48.0383 0.0) (36.1344 46.2594 0.0) (38.3947 43.8905 0.0))
   

复制代码

上面得到的点多边形UCS下的顶点，也就是用户交互输入的点集。

2、转换UCS点集到WCS下。
[pcode=lisp,true]
(setq pts1 (mapcar '(lambda(x)(trans x 1 0)) pts))
;|((43.5104 63.4743 0.0) (48.3514 68.8417 0.0) (43.991 80.9024 0.0) (46.6142
84.1325 0.0) (26.6559 82.9777 0.0) (18.8911 67.8758 0.0) (26.84 65.8903 0.0)
(33.1098 65.3466 0.0) (35.7958 63.4743 0.0))
|;
[/pcode]

上面的用户输入的多边形框顶点在WCS下的点集。

3、转换WCS点集到BLOCK坐标系点集
[pcode=lisp,true]
(setq m_b2w (MAT:RefGeom e)) ;;BLOCK->WCS的3X3矩阵和向量
;|(((0.980052 -0.198739 0.0) (0.198739 0.980052 0.0) (0.0 0.0 1.0)) (14.1578
30.4644 0.0))
|;
[/pcode]
[pcode=lisp,true]
(setq m_w2b (MAT:RevRefGeom e)) ;;WCS->BLOCK矩阵和向量
(((0.980052 0.198739 0.0) (-0.198739 0.980052 0.0) (0.0 0.0 1.0)) (-19.9298
-27.043 0.0))
[/pcode]

[pcode=lisp,true]
(setq pts2 (LM:ApplyMatrixTransformation pts1 (car m_w2b)(last m_w2b)))
;;转换WCS点到BLOCK坐标系。
;|((35.3274 26.518 0.0) (41.1387 30.8162 0.0) (39.2621 43.5029 0.0) (42.4749
46.1472 0.0) (22.6853 48.9819 0.0) (12.0741 35.7245 0.0) (19.4697 32.1989 0.0)
(25.5065 30.42 0.0) (27.7668 28.0511 0.0))
|;
[/pcode]

现在我们在原点插入老大提供的块ABC，然后根据上面BLOCK坐标系下的点集，画出多边形框，看看和UCS下的框的相对位置对不对。

老大的原图UCS下的截图：



执行上面转换后，看下面的动画演示。



可以看到UCS下的多边形顶点转换到BLOCK的坐标系下了，有奖答题的要求剩下的就是找到在这个BLOCK坐标系下在多边形框里面的实体了。

感谢高飞鸟斑竹的矩阵程序。这里面用到了MAT:RevRefGeom、LM:ApplyMatrixTransformation、MAT:RefGeom 。

关于高飞鸟斑竹的矩阵帖子，请见：LISP论矩阵

一个下午有很大收获，收工，吃饭去。晚上回来再接着研究下XDRX_API。

liuyun242

好东西，各位继续，持续关注

Lisphk

谢谢晓东，这正是我昨天发帖问的，感谢各位大侠，感谢上面LISPBOY的精彩分析，等待精彩的答案揭晓。

eachy

参考复制块内实体帖子来自: Android客户端

XDSoft

eachy 发表于 2013-4-30 22:02

                               
登录/注册后可看大图

参考复制块内实体帖子

这个和复制块内的实体还有些不同，这个要先选择出部分需要的实体，然后就是前几天讨论的怎么复制出来了。

牢固

[pcode=lisp,true](defun c:tt (/ PTINPOLYP GETTEXTENAMES POLY XREF MODE mxm mxp )
  ;;矩阵相乘
  (defun mxm (m n)
  (
   (lambda (a)
     (mapcar '(lambda (r)
                (mapcar '(lambda (s) (apply '+ (mapcar '* s r))) a)
                )
             m
             )
     )
    (apply 'mapcar (cons 'list n))
    )
  )
  ;;点的矩阵变换
  (defun mxp (m p / v)
    (setq v (append p '(1)))
    (reverse
      (cdr
        (reverse (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
        )
      )
    )
  )
  ;;判断点是否在多边形内 pl = 多边形点表 p 点
(defun ptinPolyP (PL P / I II N A)
  (setq        i  0
        ii 0
        n  (length pl)
        pl (append pl (list (car pl)))
  )
  (repeat n
    (setq a (- (angle p (nth i pl))
               (angle p (nth (1+ i) pl))
            )
    )
    (cond ((> a pi) (setq a (- a pi)))
          ((< a (* -1 pi)) (setq a (+ a pi)))
    )
    (setq ii (+ ii a)
          i  (1+ i)
    )
  )
  (if (< (abs (- (abs ii) pi)) 1e-6)
    't
    'nil
  )
)
  ;;计算在多边形内的文字实体
  ;;参数 Xref = Xref快参照图元名
  ;;     PolyPts = 多边形点表
  ;;     Filter 选择过滤表，不支持<and><or>等复杂组合过滤
  ;;     SEL-METHOD = 选择方式 窗口="W" 窗交="C"
  (defun Block:Select (XREF  PolyPts Filter SEL-METHOD            /
                                XREFDXFS INSPT           XSCALE   YSCALE
                        ZSCALE         ROTATE          BLOCKNAME            XREFDEF
                        MAT         LL          UR           UL            LR
                        LST IsXref
                       )
    (setq xrefDxfs  (entget xref) ;_ Dxf数据
          inspt            (cdr (assoc 10 xrefDxfs)) ;_ Xref的插入原点
          xscale    (cdr (assoc 41 xrefDxfs)) ;_ Xref的X比例
          yscale    (cdr (assoc 42 xrefDxfs)) ;_ Xref的Y比例
          zscale    (cdr (assoc 43 xrefDxfs)) ;_ Xref的Z比例
          rotate    (cdr (assoc 50 xrefDxfs)) ;_ Xref的旋转角
          Blockname (cdr (assoc 2 xrefDxfs)) ;_ Xref的块名
          xrefDef   (vla-item (vla-get-blocks
                                (vla-get-ActiveDocument (vlax-get-acad-object))
                              )
                              Blockname
                    ) ;_ Xref的块定义对象
          IsXref (eq :vlax-true (vla-get-isxref xrefDef))
    )
    (setq mat
           (mxm
             (list
               (list 1. 0. 0. (car inspt))
               (list 0. 1. 0. (cadr inspt))
               (list 0. 0. 1. (caddr inspt))
               (list 0. 0. 0. 1.)
             )
             (mxm
               (list
                 (list (cos rotate) (- (sin rotate)) 0. 0.0)
                 (list (sin rotate) (cos rotate) 0. 0.0)
                 '(0. 0. 1. 0.)
                 '(0. 0. 0. 1.)
               )
               (list
                 (list xscale 0. 0. 0)
                 (list 0. yscale 0. 0)
                 (list 0. 0. zscale 0)
                 '(0. 0. 0. 1.)
               )
             )
           )
    ) ;_ 图块定义的转换矩阵
    (vlax-for obj xrefDef ;_ 遍历图块
      (setq el (entget (vlax-vla-object->ename obj)))
      (if ;(= "AcDbText" (vla-get-objectname obj)) ;_ 对象为文字
        (vl-every '(lambda (x / a)
                     (and
                       (setq a (assoc (car x) el))
                       (if (= 'str (type (cdr x)))
                         (if (and
                               isxref
                               (= 8 (car x))
                               )
                           (= (strcase (VL-STRING-LEFT-TRIM (strcat Blockname "|") (cdr a))) (strcase (cdr x)))
                         (= (strcase (cdr x)) (strcase (cdr a)))
                           )
                         (equal (cdr x) (cdr a))
                       )
                     )
                   )
                  filter
        ) ;_ 不支持<and><or>等复杂组合过滤
        (progn
          (vla-GetBoundingBox obj 'll 'ur) ;_ 计算Xref文字包围框
          (setq        ll (vlax-safearray->list ll) ;_ 左下角点
                ur (vlax-safearray->list ur) ;_ 右上角点
                ul (list (car ll) (cadr ur) (caddr ll)) ;_ 左上角点
                lr (list (car ur) (cadr ll) (caddr ur)) ;_ 右下角点
                ll (mxp mat ll) ;_ 由Xref坐标转换到图形WCS坐标
                ur (mxp mat ur) ;_ 由Xref坐标转换到图形WCS坐标
                lr (mxp mat lr) ;_ 由Xref坐标转换到图形WCS坐标
                ul (mxp mat ul) ;_ 由Xref坐标转换到图形WCS坐标
          )
          (cond        ((= "C" sel-method) ;_ 窗交
                 (if (vl-some '(lambda (x) (ptinPolyP PolyPts x))
                              (list ll ur ul lr)
                     ) ;_ 文字四角点中任一点落在多边形内即被选中
                   (setq lst (cons (vlax-vla-object->ename obj) lst))
                 )
                )
                (t
                 (if (vl-every '(lambda (x) (ptinPolyP PolyPts x))
                               (list ll ur ul lr)
                     ) ;_ 文字四角点全部落在多边形内即被选中
                   (setq lst (cons (vlax-vla-object->ename obj) lst))
                 )
                )
          )
        )
      )
    )
    lst ;_ 返回Xref图元名表
  )
  (setq poly (car(entsel "\n选择多边形:")))
  (setq xref (car(entsel "\n选择外部参照块:")))
  (initget "W C")
  (setq mode (GETKWORD "\n选择方式[窗口W/窗交C]<C>:"))
  (if (null mode) (setq mode "C"))
  (setq PolyPts (mapcar 'cdr
                          (vl-remove-if-not
                            (function (lambda (x) (= 10 (car x))))
                            (entget poly)
                          )
                  )
    ) ;_ 计算多边形点表

  ;;返回多边形范围内的图元名列表
  (setq ll (Block:Select xref PolyPts '((0 . "text")(8 . "ZZ_RZ_SML")(62 . 4)) mode))
  )[/pcode]

Free-Lancer

XDSoft 发表于 2013-4-30 22:17

                               
登录/注册后可看大图

这个和复制块内的实体还有些不同，这个要先选择出部分需要的实体，然后就是前几天讨论的怎么复制出来了。

全复制出来，删除框选外部的

XDSoft

牢固 发表于 2013-4-30 22:47

                               
登录/注册后可看大图

(defun c:tt (/ PTINPOLYP GETTEXTENAMES POLY XREF MODE mxm mxp )
  
  ;;矩阵相乘

老G，整理下变成通用的函数。
处理这样的：(Block:Select '((0 . "text")(62 . 7)(8 . "层1“)....")) pts)

牢固

XDSoft 发表于 2013-4-30 23:04

                               
登录/注册后可看大图

老G，整理下变成通用的函数。
处理这样的：(Block:Select '((0 . "text")(62 . 7)(8 . "层1“)....")) p ...

9楼函数改成这样:
(Block:SelectXREF  PolyPts Filter SEL-METHOD )

Lispboy

写一个函数 Block::Select 函数，大家测试下。感谢高飞鸟斑竹、牢固斑竹。
[pcode=lisp,true]
;;;-----------------------------------------------------------;;
;;; 获得INSERT,XREF在多边形顶点内的实体名                     ;;
;;; 支持过滤表，如'((0 . "TEXT")(62 . 1)...)                  ;;
;;; 参数：                                                    ;;
;;;     ent--INSERT,XREF实体名                                ;;
;;;     pts--顶点表                                           ;;
;;;     sel--方式  "C" 交叉窗口 其他"W"                       ;;
;;;     filter--类SSGET过滤表                                 ;;
;;;返回值：实体名表
;;;-----------------------------------------------------------;;
(defun Block:Select (ent pts sel filter / lst bname e ed ll lr lst m_w2b obj pts2 ul ur x xrefdef)
  (setq ed (entget ent)
        bname (cdr (assoc 2 ed))       ; _ xref的块名
        xrefdef (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) bname) ; _ xref的块定义对象
  )
  (setq m_w2b (mat:revrefgeom ent))    ; 世界坐标系->block坐标系转换矩阵
  (setq pts (mapcar
              '(lambda (x)
                 (trans x 1 0)
               )
              pts
            )
  )
  (setq pts2 (lm:applymatrixtransformation pts (car m_w2b) (last m_w2b))) ; block坐标系下多边形框点集
  (setq pts5 nil)
  (vlax-for obj xrefdef                       ; _ 遍历图块
            (setq e (vlax-vla-object->ename obj)
                  ed (entget e)
            )
            (if (or
                  (not filter)
                  (and
                    filter
                    (vl-every '(lambda (x)
                                 (member x (entget e))
                               ) filter
                    )
                  )
                )                       ; 过滤表
              (progn
                (vla-getboundingbox obj 'll 'ur) ; _ 计算xref文字包围框
                (setq ll (vlax-safearray->list ll) ; _ 左下角点
                      ur (vlax-safearray->list ur) ; _ 右上角点
                      ll (list (car ll) (cadr ll) 0.0)
                      ur (list (car ur) (cadr ur) 0.0)
                      ul (list (car ll) (cadr ur) 0.0) ; _ 左上角点
                      lr (list (car ur) (cadr ll) 0.0) ; _ 右下角点
                )
                (cond
                  ((= "C" (strcase sel)) ; _ 交叉窗交
                    (setq pts5 (cons (list ll ur ul lr) pts5))
                    (if (vl-some '(lambda (x)
                                    (ptinpolyp pts2 x)
                                  ) (list ll ur ul lr)
                        )               ; _ 文字四角点中任一点落在多边形内即被选中
                      (progn
                        (setq lst (cons (vlax-vla-object->ename obj) lst))
                      )
                    )
                  )
                  (t
                    (if (vl-every '(lambda (x)
                                     (ptinpolyp pts2 x)
                                   ) (list ll ur ul lr)
                        )               ; _ 文字四角点全部落在多边形内即被选中
                      (setq lst (cons (vlax-vla-object->ename obj) lst))
                    )
                  )
                )
              )
            )
  )
  lst
)
;;;-----------------------------------------------------------;;
;;; 点是否在多边形内                                          ;;
;;;-----------------------------------------------------------;;
(defun ptinPolyP (PL P / I II N A)
  (setq        i  0
        ii 0
        n  (length pl)
        pl (append pl (list (car pl)))
  )
  (repeat n
    (setq a (- (angle p (nth i pl))
               (angle p (nth (1+ i) pl))
            )
    )
    (cond ((> a pi) (setq a (- a pi)))
          ((< a (* -1 pi)) (setq a (+ a pi)))
    )
    (setq ii (+ ii a)
          i  (1+ i)
    )
  )
  (if (< (abs (- (abs ii) pi)) 1e-6)
    't
    'nil
  )
)
[/pcode]

附件是高飞鸟斑竹矩阵函数支持库，运行上面函数前请加载。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Matrix-Lib.LSP 
下载次数:50  文件大小:57.23 KB 
下载权限: 不限 以上  [免费赚D豆]

cuyongping

喜欢，支持斑竹，希望高手参加！

userzhl

试了9楼 Gu_xl 修改过的程序，没能达到题目要求呢？