(XD::Block:Select)获得INSERT,XREF在多边形顶点内的实体名

Lispboy · 发表于 2013-6-30 19:28:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;-----------------------------------------------------------;;
;;; 获得INSERT,XREF在多边形顶点内的实体名 ;;
;;; 支持过滤表，如'((0 . "TEXT")(62 . 1)...) ;;
;;; 参数： ;;
;;; ent--INSERT,XREF实体名 ;;
;;; pts--顶点表 ;;
;;; sel--方式 "C" 交叉窗口其他"W" ;;
;;; filter--类SSGET过滤表 ;;
;;;返回值：实体名表
;;;-----------------------------------------------------------;;
(defun XD::Block:Select (ent pts sel filter / box cname e elist lst m_b2w m_w2b n ob pts2 x)
(if (and
(setq cname (xdrx_object_classname ent))
(eq (car cname) "INSERT")
)
(progn
(setq m_b2w (xdrx_matrix_block2wcs ent)
m_w2b (xdrx_matrix_inverse m_b2w)
pts (mapcar
'(lambda (x)
(trans x 1 0)
)
pts
)
pts2 (mapcar
'(lambda (x)
(trans (xdrx_point_transform x m_w2b) 0 1)
)
pts
)
)
(setq ob (xdrx_object_get "block" (cdr (assoc 2 (entget ent)))))
(while (setq e (xdrx_object_next))
(setq elist (cons e elist))
)
(setq elist (mapcar
'cadr
elist
)
)
(foreach n elist
(if (or
(not filter)
(and
filter
(vl-every '(lambda (x)
(member x (entget e))
) filter
)
)
) ; 过滤表
(progn
(setq box (xdrx_entity_box n))
(cond
((= "C" (strcase sel)) ; _ 交叉窗交
(if (vl-some '(lambda (x)
(apply
'xdrx_isinside
(cons x pts2)
)
) box
) ; _ 文字四角点中任一点落在多边形内即被选中
(progn
(setq lst (cons n lst))
)
)
)
(t
(if (vl-every '(lambda (x)
(apply
'xdrx_isinside
(cons x pts2)
)
) box
) ; _ 文字四角点全部落在多边形内即被选中
(setq lst (cons n lst))
)
)
)
)
)
)
)
)
lst
)

;;;-----------------------------------------------------------;; 
;;; 获得INSERT,XREF在多边形顶点内的实体名                     ;; 
;;; 支持过滤表，如'((0 . "TEXT")(62 . 1)...)                  ;; 
;;; 参数：                                                    ;; 
;;;     ent--INSERT,XREF实体名                                ;; 
;;;     pts--顶点表                                           ;; 
;;;     sel--方式  "C" 交叉窗口 其他"W"                       ;; 
;;;     filter--类SSGET过滤表                                 ;; 
;;;返回值：实体名表 
;;;-----------------------------------------------------------;; 
 
(defun XD::Block:Select (ent pts sel filter / box cname e elist lst m_b2w m_w2b n ob pts2 x) 
  (if (and 
        (setq cname (xdrx_object_classname ent)) 
        (eq (car cname) "INSERT") 
      ) 
    (progn 
      (setq m_b2w (xdrx_matrix_block2wcs ent) 
            m_w2b (xdrx_matrix_inverse m_b2w) 
            pts (mapcar 
                  '(lambda (x) 
                     (trans x 1 0) 
                   ) 
                  pts 
                ) 
            pts2 (mapcar 
                   '(lambda (x) 
                       (trans (xdrx_point_transform x m_w2b) 0 1) 
                    ) 
                   pts 
                 ) 
      ) 
      (setq ob (xdrx_object_get "block" (cdr (assoc 2 (entget ent))))) 
      (while (setq e (xdrx_object_next)) 
        (setq elist (cons e elist)) 
      ) 
      (setq elist (mapcar 
                    'cadr 
                    elist 
                  ) 
      ) 
      (foreach n elist 
        (if (or 
              (not filter) 
              (and 
                filter 
                (vl-every '(lambda (x) 
                             (member x (entget e)) 
                           ) filter 
                ) 
              ) 
            )                               ; 过滤表 
          (progn 
            (setq box (xdrx_entity_box n)) 
            (cond 
              ((= "C" (strcase sel))   ; _ 交叉窗交 
                (if (vl-some '(lambda (x) 
                                (apply 
                                  'xdrx_isinside 
                                  (cons x pts2) 
                                ) 
                              ) box 
                    )                       ; _ 文字四角点中任一点落在多边形内即被选中 
                  (progn 
                    (setq lst (cons n lst)) 
                  ) 
                ) 
              ) 
              (t 
                (if (vl-every '(lambda (x) 
                                (apply 
                                  'xdrx_isinside 
                                  (cons x pts2) 
                                ) 
                              ) box 
                    )                       ; _ 文字四角点全部落在多边形内即被选中 
                  (setq lst (cons n lst)) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  lst 
)

wzjck01 · 发表于 2021-4-5 09:41:55

授人以鱼不如授人以渔

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

[图块] (XD::Block:Select)获得INSERT,XREF在多边形顶点内的实体名

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。