排除没有
大家好，我得到了一段代码：
(defun c:HBKLICMelding ( / doc obj lay len col newlayer lst meldingnr meldingsoort meldingnrlist meldingsoortlist )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
(vla-startundomark doc)
(setq meldingnrlist '())
(setq meldingsoortlist '())
(setvar "CMDECHO" 0)
(vlax-for obj (vla-get-layers doc)
(setq lay (vla-get-name obj))
(if (wcmatch (strcase lay) "B-OI-KL-*")<THIS IS THE PART
(progn
(setq meldingnr (strcat (substr lay (-(strlen lay) 10) 9 )))
(if(=(member meldingnr meldingnrlist) nil)
(progn
(setq meldingnrlist (cons meldingnr meldingnrlist))
(setq meldingsoort (strcat (substr lay (-(strlen lay)1 )))
(if(= meldingsoort "O")
(progn
(setq meldingsoort "Oriëntatieverzoek")
)
(progn
(setq meldingsoort "Graafmelding")
)
)
(setq meldingsoortlist (cons meldingsoort meldingsoortlist))
)
)
(if (= (vla-get-Color obj) 2)
(vla-put-Color obj 40)
)
(if (= (vla-get-Color obj) 50)
(vla-put-Color obj 40)
)
(vlax-put-property obj 'LineWeight acLnWt025)
(setq col (vla-get-truecolor obj))
(if (= accolormethodbyaci (vla-get-colormethod col))
(progn
(setq lst (mapcar 'vlax-get-property (list col col col) '(red green blue)))
(vla-put-colormethod col accolormethodbyrgb)
(apply 'vla-setrgb (cons col lst))
(vla-put-truecolor obj col)
)
)
(setq len (strlen lay))
(setq newlayer (strcat (substr lay 1 1) "00" (substr lay 2 (- len 29)) (substr lay (1- len))))
(if (tblsearch "LAYER" newlayer)
(progn
(command "-LAYMRG" "Name" lay "" "Name" newlayer "Yes")
)
(progn
(vl-catch-all-apply 'vla-put-name (list obj (strcat (substr lay 1 1) "00" (substr lay 2 (- len 29)) (substr lay (1- len)))))
)
)
)
)
)
(HBLL meldingnrlist meldingsoortlist)
(setvar "CMDECHO" 1)
(vla-endundomark doc)
(princ "\nKLIC-melding gereed.")
(princ)
)
换句话说：
（如果（和（wcmatch（strcase lay）“B-OI-KL-*”）（ssget“_X”（list（cons 8 lay）））
页:
[1]