[求助]：请教高手，谁有这样一个带提示和过滤表的entsel？

userzhluserzhl · 发表于 2009-6-11 10:40:59

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

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

×

请教高手，谁有这样一个带提示和过滤表的entsel？

(setq aa (X-Entsel "\n请选择文字:" nil '((0 . "*TEXT"))))

秋枫 · 发表于 2009-6-11 14:10:13

[FONT=courier new]
;;;I:EntSelF
;;;(entsel)和(ssget)的结合，与(entsel)不同，你可提供一个过滤器。与(ssget)不同，你可提供一个提示。
;;;参数
;;;Msg：选择提示字符串，或为空。Filter：(ssget)形式的过滤器，或为空。
;;;示例
;;;(I:EntSelF "polyline: " '((0 . "Polyline,LWPolyline")))
;;;注意
;;;以上例子将返回如下，如果多义线在选择框区域内：(<Entity name: 19bb188> (12.14 11.0767 0.0))，或者如无多义线则为空(nil)。
;;;在图形对象非常多的图形中该程序是非常有用的。
;;;作者
;;;[B][Color=Navy]R. Robert Bell[/Color][/B]
(defun I:EntSelF
(Msg ; selection prompt
Filter ; filter list
/ EntN ; (entsel) list, or "Exit" string
pbDist ; pickbox size in drawing units
PtPick ; point of selection from (entsel)
ssPick ; selection set
) ;_ closes variable declare
(while (not EntN) ; while no selection (or no exit)
(setq
EntN (if Msg ; if selection prompt
(entsel Msg) ; then (entsel) w/prompt
(entsel) ; else plain (entsel)
) ;_ closes if
) ;_ closes setq
(if (= (getvar "ErrNo") 52) ; if null response
(setq EntN "Exit") ; then set flag to exit
) ;_ closes if
) ;_ closes while
(cond
((/= EntN "Exit") ; if not exit
(setq
pbDist (abs ; return absolute number
(/
(*
(/ ; get pixel ratio
(getvar "PickBox")
(cadr (getvar "ScreenSize"))
)
(getvar "ViewSize") ; apply to viewsize
) ;_ closes *
(sin (* 0.25 pi)) ; at 45?
) ;_ closes /
) ;_ closes abs
PtPick (cadr EntN) ; get point of pick
) ;_ closes setq
(if (setq ssPick (ssget "_C" ; if entities in crossing
(polar PtPick (* 1.25 pi) pbDist)
(polar PtPick (* 0.25 pi) pbDist)
Filter ; match filter, if any
) ;_ closes ssget
) ;_ closes setq
(cons ; then return first entity as (entsel)
(ssname ssPick 0)
(list PtPick)
) ;_ closes cons
) ;_ closes if
) ;_ closes condition
) ;_ closes cond
) ;_ closes defun I:EntSelF[/FONT]

[FONT=courier new] 
;;;I:EntSelF 
;;;(entsel)和(ssget)的结合，与(entsel)不同，你可提供一个过滤器。与(ssget)不同，你可提供一个提示。 
;;;参数 
;;;Msg：选择提示字符串，或为空。Filter：(ssget)形式的过滤器，或为空。 
;;;示例 
;;;(I:EntSelF "polyline: " '((0 . "Polyline,LWPolyline"))) 
;;;注意 
;;;以上例子将返回如下，如果多义线在选择框区域内：(<Entity name: 19bb188> (12.14 11.0767 0.0))，或者如无多义线则为空(nil)。 
;;;在图形对象非常多的图形中该程序是非常有用的。 
;;;作者 
;;;[B][Color=Navy]R. Robert Bell[/Color][/B] 
 
(defun I:EntSelF 
                 (Msg                        ; selection prompt 
                  Filter                ; filter list 
                  / EntN                ; (entsel) list, or "Exit" string 
                  pbDist                ; pickbox size in drawing units 
                  PtPick                ; point of selection from (entsel) 
                  ssPick                ; selection set 
) ;_ closes variable declare 
  (while (not EntN)                        ; while no selection (or no exit) 
    (setq 
      EntN (if Msg                        ; if selection prompt 
             (entsel Msg)                ; then (entsel) w/prompt 
 
             (entsel)                        ; else plain (entsel) 
           ) ;_ closes if 
    ) ;_ closes setq 
    (if        (= (getvar "ErrNo") 52)                ; if null response 
      (setq EntN "Exit")                ; then set flag to exit 
    ) ;_ closes if 
  ) ;_ closes while 
  (cond 
    ((/= EntN "Exit")                        ; if not exit 
     (setq 
       pbDist (abs                        ; return absolute number 
                (/ 
                  (* 
                    (/                        ; get pixel ratio 
                      (getvar "PickBox") 
                      (cadr (getvar "ScreenSize")) 
                    ) 
                    (getvar "ViewSize")        ; apply to viewsize 
                  ) ;_ closes * 
                  (sin (* 0.25 pi))        ; at 45? 
                ) ;_ closes / 
              ) ;_ closes abs 
       PtPick (cadr EntN)                ; get point of pick 
     ) ;_ closes setq 
     (if (setq ssPick (ssget "_C"        ; if entities in crossing 
                             (polar PtPick (* 1.25 pi) pbDist) 
                             (polar PtPick (* 0.25 pi) pbDist) 
                             Filter        ; match filter, if any 
                      ) ;_ closes ssget 
         ) ;_ closes setq 
       (cons                                ; then return first entity as (entsel) 
         (ssname ssPick 0) 
         (list PtPick) 
       ) ;_ closes cons 
     ) ;_ closes if 
    ) ;_ closes condition 
  ) ;_ closes cond 
) ;_ closes defun I:EntSelF[/FONT]

userzhluserzhl · 发表于 2009-6-11 14:15:59

谢谢秋枫斑竹！

carrot1983 · 发表于 2009-6-11 17:22:37

偶也来一个。

;;;(JW-ENTSEL "\n选择多段线: " '((0 . "Polyline,LWPolyline")))
;;;用ssget实现entsel过滤选择
;;;By carrot1983 6/11/09
(defun JW-ENTSEL (MSG FILTER / SS LST)
(prompt MSG)
(if (setq SS (ssget ":S:E" FILTER))
(progn
(setq LST (car (ssnamex SS 0)))
(list (cadr LST) (cadr (last LST)))
)
)
)

userzhluserzhl · 发表于 2009-6-14 23:48:36

我试了二楼和四楼的程序,达不到我的要求.
这是shlisp的一个函数:
增强型entsel
语法
(gps->entsel msg keyword filter_list)

功能及参数
变量 [类型]:
msg = 注释 [STR]
keyword = initget的keyword [STR]
filter_list = 过滤字符表.参见ssget [LIST]

范例
1.(gps->entsel "\n选择直线或圆/Undo/Option/eXit"

 "Undo Option eXit" '((0 . "*LINE,CIRCLE,ARC")))

2.

(while (= (type (setq ent (gps->entsel
 "\n提示:" "X H Y N" '((0 . "*LINE,CIRCLE,ARC")))))
 'STR)

(cond ((= ent "X")())
 ((= ent "H")())
)
)

　

　

blog | 网络U盘 | 意见

--------------------------------------------------------------------------------

;只选择半径为1的圆.
1. (ssget '((-4 . "<AND")(0 . "CIRCLE")(40 . 1.0) (-4 . "AND>")))

2. (gps->entsel "\n圆/Undo/Option/eXit" "Undo Option eXit"
'((-4 . "<AND")(0 . "CIRCLE")(40 . 1.0) (-4 . "AND>")))

3. (gps->nentsel "\n圆/Undo/Option/eXit" "Undo Option eXit"
'((-4 . "<AND")(0 . "CIRCLE")(40 . 1.0) (-4 . "AND>")))
 gps->nentsel建议不要使用-4的组码过滤.有-4组码时.过滤块中物体时采用entmak生成子体再过滤.

 对于非统一比例的块可能不对.

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

[求助] [求助]：请教高手，谁有这样一个带提示和过滤表的entsel？

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

相关帖子