fengyu6913 发表于 2024-8-21 19:38:54

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



论坛找到的，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 (+ 1j))
)
(PRINC (strcat "共找到"(rtos i 2 0)"处!"))
(command "layer" "s" bl "")
)
(princ "没有找到你要的内容!")
)
)



黄翔 发表于 2024-8-21 19:38:55

(defun c:tt ()
(command "cmdecho" "0")
(command "osmode" "0")
(setq bl (getvar "clayer"))
(princ "\n   请在屏幕拾取文字：")
(if (setq cc (entsel"【注意】只能选择块或文字:"))
   (progn
(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))
   
    (if (= nnn "TEXT")
        (setq ss (ssget "x" (list '(0 . "MTEXT,TEXT")lr)))
    )
    (if (= nnn "MTEXT")
      (SETQ SS (SSGET "X" (LIST '(0 . "MTEXT,TEXT")lr)))
      )
    (if (= nnn "INSERT")
      (setq ss (ssget "x" (list name km )))
      )
    )
    (princ "没有选择任何内容!")
    )
   
    (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 pt_cc "")

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

)

kozmosovia 发表于 2024-8-21 20:06:04

本帖最后由 kozmosovia 于 2024-8-21 20:07 编辑

把 (cons 8 a1)去掉就是了

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

fengyu6913 发表于 2024-8-21 22:03:35

感谢各位大佬的帮助与分享！
页: [1]
查看完整版本: 如何改写下，不过滤图层？