搜索lisp
大家好我需要一个lisp来搜索整个图形中特定层中的所有文本，如果有两个以上相同的文本，我需要它将它们涂成黄色。
例如：
如果图纸中有三个文本的值为“4 T32-562”，我需要将所有这三个文本都涂成黄色，以此类推。
提前非常感谢。
祝大家今天愉快 你好
(defun C:test ( / e enx lyr SSX i Lst dupes )
(sssetfirst nil nil)(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
(setq e (car (entsel "\nSelect text object to filter by its layer <exit>: ")))
(cond
((= 7 (getvar 'errno)) (princ "\nMissed.") (setvar 'errno 0))
((and e (wcmatch (cdr (assoc 0 (setq enx (entget e)))) "~*TEXT"))
(princ "\nThis is not a text object.")
)
((and e (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (setq lyr (assoc 8 enx)))))))))
(princ "\nThis text is on a locked layer.")
)
(e
(if (setq SSX (ssget "_X" (list (cons 0 "*TEXT") lyr)))
(progn
(repeat (setq i (sslength SSX))
(setq enx (entget (setq e (ssname SSX (setq i (1- i))))))
(setq Lst (cons (cons e (cdr (assoc 1 enx))) Lst))
)
(and Lst
(setq dupes (LM:ListDupes (mapcar 'cdr Lst)))
(mapcar (function (lambda (x) (PutIndexColor (car x) 2)))
(vl-remove-if-not
(function
(lambda (x)
(member (cdr x) dupes)
)
)
Lst
)
)
)
)
)
(setvar 'errno 52)
)
)
)
(princ)
) (vl-load-com) (princ)
(defun PutIndexColor ( e col / enx )
(and
(eq 'ENAME (type e)) (eq 'INT (type col)) (<= 0 col 256)
(setq enx (vl-remove-if (function (lambda (x) (= 420 (car x)))) (entget e))) ; remove the true color if present
(or
(and (assoc 62 enx) (entmod (subst (cons 62 col) (assoc 62 enx) enx)))
(entmod (append enx (list (cons 62 col))))
)
)
)
;; List Duplicates-Lee Mac
;; Returns a list of items appearing more than once in a supplied list
(defun LM:ListDupes ( l )
(if l
(if (member (car l) (cdr l))
(cons (car l) (LM:ListDupes (vl-remove (car l) (cdr l))))
(LM:ListDupes (vl-remove (car l) (cdr l)))
)
)
)
也许有人会跳进来-大卫 大卫，试试看：
(setq s "T 32-562 " ; String to match
sl "3D") ;Search LAyer
(setq ss (ssget "X" (list (cons 0 "TEXT")(cons 8 sl)(cons 1 s))))
https://www.cadtutor.net/forum/attachment.php?attachmentid=60197&cid=1&stc=1
谢谢你们的回复；
@Grrr它起作用了，但它为重复多次的文本着色。。你能把它调整到复制两次以上的文本上吗
请参阅所附图像。。。最重要的是你的Lisp程序做了什么。。。底部是我需要它做的。
再次感谢大家：）
抱歉，我的任何版本都无法使用。我尝试了各种组合-大卫 现在我知道你在问术士-993：
(setq s "T 32`-562 `")
对不起，大卫，
我认为层过滤器组码的工作方式类似于wcmatch函数。
我对此已经没有主意了。 @非常感谢，它工作得很好 @大卫：
你确定你用了*反向*引号吗？ 我已经放弃了ssget过滤器。只需把课文读两遍。
通过关联列表在vanilla AutoLisp中
(defun C:test ;| credits to: Lee Mac, Michael Puckett |; ( / morethan e enx lyr SSX i Lst dupes lyrs )
(or
(and (not (initget (+ 2 4))) (setq morethan (getint "\nSpecify more than value <3>: " )))
(setq morethan 3)
)
(sssetfirst nil nil)(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
(setq e (car (entsel "\nSelect text object to filter by its layer <exit>: ")))
(cond
((= 7 (getvar 'errno)) (princ "\nMissed.") (setvar 'errno 0))
((and e (wcmatch (cdr (assoc 0 (setq enx (entget e)))) "~*TEXT"))
(princ "\nThis is not a text object.")
)
((and e (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (setq lyr (assoc 8 enx)))))))))
(princ "\nThis text is on a locked layer.")
)
(e
(if (setq SSX (ssget "_X" (list (cons 0 "*TEXT") lyr)))
(progn
(repeat (setq i (sslength SSX))
(setq enx (entget (setq e (ssname SSX (setq i (1- i))))))
(setq Lst (cons (cons e (cdr (assoc 1 enx))) Lst))
)
(and
(setq lyrs
(mapcar 'car
(vl-remove-if
(function (lambda (x) (> morethan (cdr x))))
(_TallyHo (mapcar 'cdr Lst))
)
)
)
(mapcar
(function (lambda (x) (PutIndexColor (car x) 2)))
(setq Lst (vl-remove-if-not (function (lambda (x) (member (cdr x) lyrs))) Lst))
)
(not (alert (strcat "\nFound " (itoa (length Lst)) " duplicate texts, that occur more than " (itoa morethan) " times.")))
)
)
)
(setvar 'errno 52)
)
)
)
(princ)
) (vl-load-com) (princ)
(defun PutIndexColor ( e col / enx )
(and
(eq 'ENAME (type e)) (eq 'INT (type col)) (<= 0 col 256)
(setq enx (vl-remove-if (function (lambda (x) (= 420 (car x)))) (entget e))) ; remove the true color if present
(or
(and (assoc 62 enx) (entmod (subst (cons 62 col) (assoc 62 enx) enx)))
(entmod (append enx (list (cons 62 col))))
)
)
)
; Michael Puckett's assembly:
;(_TallyHo
;'(
; ("A" "B" 10)
; ("A" "C" 20)
; ("B" "C" 10)
; ("A" "B" 10)
; ("A" "C" 20)
; ("A" "B" 10)
;)
;)
;>>
;(
;(("A" "B" 10) . 3)
;(("A" "C" 20) . 2)
;(("B" "C" 10) . 1)
;)
(defun _TallyHo ( lst )
(defun _Positions ( x lst / p )
;;find all the positions of x in lst
;;(_Positions 1 '(0 0 1 0 0 1)) >> (2 5)
(if (setq p (vl-position x lst))
( (lambda ( lst result )
(while (setq p (vl-position x lst))
(setq
result (cons (+ 1 p (car result)) result)
lst (cdr (member x lst))
)
)
(reverse result)
)
(cdr (member x lst))
(list p)
)
)
)
(defun _Tally ( x lst )
;;count all the occurances of x in lst
;;(_Tally 1 '(0 0 1 0 0 1)) >> 2
(length (_Positions x lst))
)
(defun _Distil ( lst / result )
(while lst
(setq
result (cons (car lst) result)
lst (vl-remove (car result) (cdr lst))
)
)
(reverse result)
)
(mapcar
(function (lambda (x) (cons x (_Tally x lst))))
(_Distil lst)
)
)
-大卫
对我甚至试着避开括号“\”
页:
[1]
2