如何改写下，不过滤图层？

fengyu6913

论坛找到的，xiabin68的程序，想改写下，不过滤图层

请大佬帮忙！


;;给大家一个查找文字，块并用线指出来的程序，作者：xiabin68

(defun c:tt ()
(command "cmdecho" "0")
(command "osmode" "0")
(setq bl (getvar "clayer"))
(initget 7 "1 2")

;;(setq b (getkword "\n 1 屏幕拾取／2 键入:"))
(princ "\n   请在屏幕拾取文字：")
(setq b "1")

(if (= b "1")
     (progn
(setq cc (entsel"  【注意】只能选择块或文字:"))
;(setq pt_cc (getpoint  "\n 指定定位连线端点："))
(setq pt_cc (cadr cc))


(if (/= cc nil)
(progn
(setq c (entget (car cc)))
(setq nnn (cdr (assoc 0 c)))
(setq name (assoc 0 c))
(setq lr (assoc 1 c))
(setq km (assoc 2 c))
(setq a1 (assoc 8 c))
(if (= nnn "TEXT")
    (setq ss (ssget "x" (list '(0 . "MTEXT,TEXT") a1 lr)))
)
(if (= nnn "MTEXT")
  (SETQ SS (SSGET "X" (LIST '(0 . "MTEXT,TEXT") a1 lr)))
  )
(if (= nnn "INSERT")
  (setq ss (ssget "x" (list name km a1)))
  )
)
(princ "没有选择任何内容!")
)
)
     )
(if (= b "2")
  (progn
  (setq a (getstring "要查找的字符串:"))
   (setq a1 (getstring "字符串所在图层:"))
   (setq ss (ssget "x" (list '(0 . "MTEXT,TEXT") (cons 1 (STRCAT "*"a"*" "," "*"a "," a"*")) (cons 8 a1))))
  )
  )
(if (/= ss nil)
(progn
(setq i (sslength ss))
(setq j 0)
(command "-layer" "m" "BJTP" "C" "1" "" "")
(repeat i
(setq a (entget (ssname ss j)))
(setq XY (cdr (assoc 10 a)))

;;(COMMAND "LINE" XY "-1500,-1500" "")
(COMMAND "LINE" XY pt_cc "")

(setq j (+ 1  j))
  )
(PRINC (strcat "共找到"(rtos i 2 0)"处!"))
(command "layer" "s" bl "")
  )
  (princ "没有找到你要的内容!")
  )
)
  

黄翔

1. (defun c:tt ()
   
2. (command "cmdecho" "0")
   
3. (command "osmode" "0")
   
4. (setq bl (getvar "clayer"))
   
5. (princ "\n   请在屏幕拾取文字：")
   
6. (if (setq cc (entsel"  【注意】只能选择块或文字:"))
   
7.      (progn
   
8.   (setq pt_cc (cadr cc))
   
9.     (if (/= cc nil)
   
10.     (progn
    
11.     (setq c (entget (car cc)))
    
12.     (setq nnn (cdr (assoc 0 c)))
    
13.     (setq name (assoc 0 c))
    
14.     (setq lr (assoc 1 c))
    
15.     (setq km (assoc 2 c))
    
16.    
    
17.     (if (= nnn "TEXT")
    
18.         (setq ss (ssget "x" (list '(0 . "MTEXT,TEXT")  lr)))
    
19.     )
    
20.     (if (= nnn "MTEXT")
    
21.       (SETQ SS (SSGET "X" (LIST '(0 . "MTEXT,TEXT")  lr)))
    
22.       )
    
23.     (if (= nnn "INSERT")
    
24.       (setq ss (ssget "x" (list name km )))
    
25.       )
    
26.     )
    
27.     (princ "没有选择任何内容!")
    
28.     )
    
29.    
    
30.     (if (/= ss nil)
    
31. (progn
    
32. (setq i (sslength ss))
    
33. (setq j 0)
    
34. (command "-layer" "m" "BJTP" "C" "1" "" "")
    
35. (repeat i
    
36. (setq a (entget (ssname ss j)))
    
37. (setq XY (cdr (assoc 10 a)))
    
38. 
    
39. (COMMAND "LINE" XY pt_cc "")
    
40. 
    
41. (setq j (+ 1  j))
    
42.   )
    
43. (PRINC (strcat "共找到"(rtos i 2 0)"处!"))
    
44. (command "layer" "s" bl "")
    
45.   )
    
46.   (princ "没有找到你要的内容!")
    
47.   )
    
48.    
    
49.    
    
50.    
    
51.    
    
52. )
    
53.      )
    
54. 
    
55. )

(defun c:tt ()<br /> (command "cmdecho" "0")<br /> (command "osmode" "0") <br /> (setq bl (getvar "clayer"))<br /> (princ "\n   请在屏幕拾取文字：")<br /> (if (setq cc (entsel"  【注意】只能选择块或文字:"))<br />      (progn<br />   (setq pt_cc (cadr cc))<br />     (if (/= cc nil)<br />     (progn<br />     (setq c (entget (car cc)))<br />     (setq nnn (cdr (assoc 0 c)))<br />     (setq name (assoc 0 c))<br />     (setq lr (assoc 1 c))<br />     (setq km (assoc 2 c))<br />     <br />     (if (= nnn "TEXT")<br />         (setq ss (ssget "x" (list '(0 . "MTEXT,TEXT")  lr)))<br />     )<br />     (if (= nnn "MTEXT")<br />       (SETQ SS (SSGET "X" (LIST '(0 . "MTEXT,TEXT")  lr)))<br />       )<br />     (if (= nnn "INSERT")<br />       (setq ss (ssget "x" (list name km )))<br />       )<br />     )<br />     (princ "没有选择任何内容!")<br />     )<br />     <br />     (if (/= ss nil)<br /> (progn<br /> (setq i (sslength ss)) <br /> (setq j 0)<br /> (command "-layer" "m" "BJTP" "C" "1" "" "")<br /> (repeat i<br /> (setq a (entget (ssname ss j)))<br /> (setq XY (cdr (assoc 10 a)))<br /> <br /> (COMMAND "LINE" XY pt_cc "")<br /> <br /> (setq j (+ 1  j))<br />   )<br /> (PRINC (strcat "共找到"(rtos i 2 0)"处!"))<br /> (command "layer" "s" bl "")<br />   )<br />   (princ "没有找到你要的内容!")<br />   )<br />     <br />     <br />     <br />     <br /> )<br />      )<br /> <br /> )

kozmosovia

把 (cons 8 a1)去掉就是了

(setq ss (ssget "x" (list '(0 . "MTEXT,TEXT") a1 lr)))
(setq ss (ssget "x" (list name km a1)))
去掉a1

fengyu6913

感谢各位大佬的帮助与分享！