[原创]带提示和过滤表的entsel

meflying

功能：类似于(entsel)函数，带提示，且带一个过滤表，只选择表中类型
例子：(sel '("LINE" "LWPOLYLINE") "选择直线...")
返回：同(entsel)一样，(对象名 选择点)

2. 
   
3. (defun Sel (_types msg / gr ent m ty)
   
4.   (defun com(ty tylst / i rVal)
   
5.     (setq i 0)
   
6.     (while (< i (length tylst))
   
7.       (if (= ty (nth i tylst))
   
8.         (progn (setq rVal t) (setq i (length tylst)))
   
9.       )
   
10.       (setq i (1+ i))
    
11.     )
    
12.     rVal
    
13.   )
    
14.   (prompt msg)
    
15.   (setq m nil)
    
16.   (while (not m)
    
17.     (setq gr (grread 2 4 2))
    
18.     (cond
    
19.       ((= (car gr) 3)
    
20.        (setq ent (ssget (cadr gr)))
    
21.        (if (not (and ent (com (cdr (assoc 0 (entget (setq ent (ssname  ent 0))))) _types)))
    
22.          
    
23.          (setq ent nil)
    
24.        )
    
25.        (setq m t)
    
26.       )
    
27.       ((= (car gr) 25) (setq m t))
    
28.     )
    
29.   )
    
30.   (princ "\n")
    
31.   (if ent (list ent (cadr gr)) nil)
    
32. )
    
33. 
    

<br /> (defun Sel (_types msg / gr ent m ty)<br />   (defun com(ty tylst / i rVal)<br />     (setq i 0)<br />     (while (< i (length tylst))<br />       (if (= ty (nth i tylst))<br />         (progn (setq rVal t) (setq i (length tylst)))<br />       )<br />       (setq i (1+ i))<br />     )<br />     rVal<br />   )<br />   (prompt msg)<br />   (setq m nil)<br />   (while (not m)<br />     (setq gr (grread 2 4 2))<br />     (cond<br />       ((= (car gr) 3)<br />        (setq ent (ssget (cadr gr)))<br />        (if (not (and ent (com (cdr (assoc 0 (entget (setq ent (ssname  ent 0))))) _types)))<br />          <br />          (setq ent nil)<br />        )<br />        (setq m t)<br />       )<br />       ((= (car gr) 25) (setq m t))<br />     )<br />   )<br />   (princ "\n")<br />   (if ent (list ent (cadr gr)) nil)<br /> )<br /> <br />

BDYCAD

這個應該做到, 如果選錯了要返回重新選嘛.   這樣就更好了

meflying

(entsel)选错了能返回重新选吗？我这个函数说了就是类似entsel的，不要总是挑这挑那，你也会编程，有要求为什么不自己写一个？

龙龙仔

2. 
   
3. ;;BY 龙龙仔(LUCAS)
   
4. ;;USAGE:(ENTSEL_LAI "\n选择直线或圆..." '((0 . "*LINE,CIRCLE")))
   
5. (defun ENTSEL_LAI (MSG FILTER / SS SSS)
   
6.   ;;(while (not SS)
   
7.   (setq SS (entsel MSG))
   
8.   (if (/= SS NIL)
   
9.     (progn
   
10.       (command "_.SELECT" (car SS) "")
    
11.       (if (not (setq SSS (ssget "P" FILTER)))
    
12.         (setq SS NIL)
    
13.         (list (ssname SSS 0) (cadr SS))
    
14.       )
    
15.     )
    
16.   )
    
17.   ;;)
    
18. )
    
19. 
    
20. ;;USAGE:(ENTSEL_MSG_FILTER "\n选取POLYINE对象: " '((0 . "LWPolyline")))
    
21. (defun ENTSEL_MSG_FILTER (MSG FILTER / SSPICK PICKOBJ PT1)
    
22.   (prompt MSG)
    
23.   (setq SSPICK (ssget ":S" FILTER))
    
24.   (if SSPICK
    
25.     (progn
    
26.       (setq PICKOBJ (car (ssnamex SSPICK 0)))
    
27.       (setq PT1 (cadr (nth 3 PICKOBJ)))
    
28.       (list (nth 1 PICKOBJ) PT1)
    
29.     )
    
30.   )
    
31. )
    
32. 
    

<br /> ;;BY 龙龙仔(LUCAS)<br /> ;;USAGE:(ENTSEL_LAI "\n选择直线或圆..." '((0 . "*LINE,CIRCLE")))<br /> (defun ENTSEL_LAI (MSG FILTER / SS SSS)<br />   ;;(while (not SS)<br />   (setq SS (entsel MSG))<br />   (if (/= SS NIL)<br />     (progn<br />       (command "_.SELECT" (car SS) "")<br />       (if (not (setq SSS (ssget "P" FILTER)))<br />         (setq SS NIL)<br />         (list (ssname SSS 0) (cadr SS))<br />       )<br />     )<br />   )<br />   ;;)<br /> )<br /> <br /> ;;USAGE:(ENTSEL_MSG_FILTER "\n选取POLYINE对象: " '((0 . "LWPolyline")))<br /> (defun ENTSEL_MSG_FILTER (MSG FILTER / SSPICK PICKOBJ PT1)<br />   (prompt MSG)<br />   (setq SSPICK (ssget ":S" FILTER))<br />   (if SSPICK<br />     (progn<br />       (setq PICKOBJ (car (ssnamex SSPICK 0)))<br />       (setq PT1 (cadr (nth 3 PICKOBJ)))<br />       (list (nth 1 PICKOBJ) PT1)<br />     )<br />   )<br /> )<br /> <br />

myfreemind

程序不错！！

无痕

不用写那么多行

2. ;;(xentsel) = 带提示和过滤表的entsel (ssget "p" f)方法.精简代码!---------------------------------------------BY 无痕
3. ;;调用:(XENTSEL "\n选择直线或圆..." '((0 . "*LINE,CIRCLE")))
4. ;;循环选则直到选中符合过滤的实体为止(defun xentsel (msg filter)
5.    (while (not (and (setq el (entsel msg)) (ssget "p" filter))))
6.    el
7. );;调用:(XENTSEL1 "\n选择直线或圆..." '((0 . "*LINE,CIRCLE")))
8. ;;只选一次，返回点表 (实体名 . 点位)；选不中或空选返回nil.(defun xentsel1 (msg filter)
9.    (if (and (setq el (entsel msg)) (ssget "p" filter)) el nil)
10. )

;;(xentsel) = 带提示和过滤表的entsel (ssget "p" f)方法.精简代码!---------------------------------------------BY 无痕 ;;调用:(XENTSEL "\n选择直线或圆..." '((0 . "*LINE,CIRCLE"))) ;;循环选则直到选中符合过滤的实体为止(defun xentsel (msg filter)    (while (not (and (setq el (entsel msg)) (ssget "p" filter))))    el );;调用:(XENTSEL1 "\n选择直线或圆..." '((0 . "*LINE,CIRCLE"))) ;;只选一次，返回点表 (实体名 . 点位)；选不中或空选返回nil.(defun xentsel1 (msg filter)    (if (and (setq el (entsel msg)) (ssget "p" filter)) el nil) )

bbo

xie xie

SWAYWOOD

无痕发表于2004-1-24 5:59:00不用写那么多行 ;;(xentsel) = 带提示和过滤表的entsel (ssget \"p\" f)方法.精简代码!---------------------------------------------BY 无痕

无痕大侠，我在用xentsel函数时出了点问题 1.我用(setq p (xentsel "\n选择需修改的标注 :" '((0 . "DIMENSION"))))这句时，无法返回结果 2.我用(XENTSEL "\n选择直线或圆..." '((0 . "*LINE,CIRCLE")))选择标注时却可以返回标注的DXF 据我分析应该是entsel选择后并不记录为“最近的选择集”，及“p”对其无效……

龙龙仔

(defun XENTSEL (MSG FILTER)
(while (not (and (setq EL (entsel MSG))
(progn (command "_.select" (car EL) "")
(ssget "p" FILTER)
)
)
)
)
EL
)

SWAYWOOD

(defun xentsel (msg filter)
(while (not (and (setq el (entsel msg)) (ssget (cadr el) filter))))
el
)