[编程交流] wcmatch

(defun c:test ( /  fname)
(INSERT1)
(if fname
 (cond
 (wcmatch fname "P*-1*")(STAMP_1)
 (wcmatch fname "P*-2*")(STAMP_2)
 ))
 );defun

(defun c:test ( /  fname)
(INSERT1)
(if fname
 (cond
 ((wcmatch fname "P*-1*") T) (STAMP_1)
 ((wcmatch fname "P*-2*") T) (STAMP_2)
 ))
 );defun

(defun c:test ( /  fname )
 (INSERT1)
 
 (if fname
   (cond
     ( (wcmatch fname "P*-1*") (STAMP_1) ) 
     ( (wcmatch fname "P*-2*") (STAMP_2) ) 
   )
 )
)

(defun c:test ( /  fname )
 (INSERT1)
 
 (if fname
   (cond
     (  (wcmatch fname "P*-1*") (STAMP_1) ) 
     (  (wcmatch fname "P*-2*") (STAMP_2) ) 
     (t (alert "No Conditions Met") )
   )
 )
)

(Defun checkxref ()
(if (tblsearch "layer" "P-------XREF")
(command "_layer" "s" "P-------XREF" "")
(command "_layer" "m" "P-------XREF"
"c" "7" "" "lo"
"P-------XREF" ""
)
)
)
(defun STAMP_1 (/ stamp1 oldlay )
(initerr)
(progn
(setq stamp1 (strcat "..\\..\\KOMP_FIL\\Stämpel\\STAMP\\_STAMP-1.dwg"))
;(checkxref)
(setq point0 (strcat "0,0,0"))
(command "-insert" stamp1 point0 "1" "1" "0" "" "" "" "" "" "" "" "" "" "")
)
)
(defun STAMP_2 (/ stamp2 oldlay )
(initerr)
(progn
(setq stamp2 (strcat "..\\..\\KOMP_FIL\\Stämpel\\STAMP\\_STAMP-2.dwg"))
;(checkxref)
(setq point0 (strcat "0,0,0"))
(command "-insert" stamp2 point0 "1" "1" "0" "" "" "" "" "" "" "" "" "" "")
)
)
;;; CODE ORIGINALLY WRITTEN BY Lee_Mac, Thank you
(defun INSERT1 (/ laycode lay_name fname oldlay path test)
;laycodes is a list of a drawing paths, layer names and preset colors.
;Each list within laycodes contains 3 elements (<path> <layer name> <layer color>)
;The first element is the block path.
;The second element is the layer name associated with the block
;The third item in a list references the layer color
;Any blocks found to come from a particular path will be inserted on a preset layer
;If the layer does not exist it will be created and a layer color assigned to it
;
;eg
;("K:\\CAD\\Block\\arrow" "A-------O2-" 1)
;A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-" which has a color 1
;
;Note the path is case sensitive
;(NAMNRUTA)
(command "_.layer" "s" 0 "")
(setq laycodesrelativepath (dos_relativepath "U:\\?\\?\\A\\Ritningar\\RITDEF\\?" "U:\\?\\?\\A\\Ritningar\\KOMP_FIL\\Stämpel" ))
(setq point0 (strcat "0,0,0"))
(setq laycodes '(
("U:\\p-q-r\\RF_TEST_AU\\A\\Ritningar\\KOMP_FIL\\Stämpel" "A-------F1-" 4) ;<-edit this list as required
)
)
(setq stamppath (dos_relativepath "U:\\?\\?\\A\\Ritningar\\RITDEF\\?" "U:\\?\\?\\A\\Ritningar\\KOMP_FIL\\Stämpel" ))
(IF (= (getvar "tilemode") 0)
(progn
(if
;select the drawing to insert
(and (setq fname (dos_dwgpreview "Välj NAMNRUTA:" stamppath ".dwg")) (/= fname ""))
;if a file has been selected
(progn
;store the current layer
(setq oldlay (getvar "clayer"))
;retrieve the path
(setq path (vl-filename-directory fname))
(if
;check the path against the laycodes
(setq test (assoc path laycodes))
;if a match is found
(or
;test if the preset layer exists
(tblsearch "layer" (setq lay_name (cadr test)))
;if it does not add it
(and
(command "layer" "m" lay_name "c" (caddr test) lay_name "")
;<-line added to change the layer to the required color
)
)
;if the file does not match the predefined
(alert
(strcat "\n<" (vl-filename-base fname) "> är EJ vald från GILTIG katalog"
" \nGiltiga Kataloger är :"
(apply 'strcat (mapcar '(lambda (x) (strcat "\n\t" (car x))) laycodes))
"\nBlock <" (vl-filename-base fname) "> skall vara infogad i lager <" (getvar "clayer")">")))
(and lay_name (setvar "clayer" lay_name))
(setvar "cmdecho" 0)
(command "_.xref" "o" fname "0,0" "" "" "" )
(and lay_name (setvar "clayer" oldlay))
)
(alert "\nIngen fil vald...")
)
(princ))(alert "Infoga Skalsymbol i RitDef:ar istället!!"))
(C:XR:RelativePath)
)
;;;
(defun c:test ( / svar fname)
;;;(setq flag (dos_msgbox "Spara på Rätt ställe. Om Sparat, tryck JA/YES, om ej Spara och kör igen!" 4 3))
;;; ;display the message box
;;;
;;;
;;; (if (= flag 6)
;;; ;if Yes selected
;;; (progn
;;; (initdia)
;;;(if (/= (getvar "ctab") "Model")
;;; (progn
;;; (setq
;;; svar (dos_msgbox
;;;"SPARA på RÄTT STÄLLE. Om sparat VÄLJ JA, annars nej och SPARA på rätt ställe och KÖR IGEN!)"
;;; "SÄTT IN STÄMPEL!"
;;; 4
;;; 3
;;; )
;;; )
;;; (IF (= svar 6)
;;;
(progn
(INSERT1)
(if fname
(cond
( (wcmatch fname "PNAMN*1*") (STAMP_1) ) 
( (wcmatch fname "PNAMN*2*") (STAMP_2) ) 
)
))
)
(princ) 
;;; (initdia)
;;; (command "_.save")

(defun c:test ()
 (INSERT1)
 (if (ssget "x" '((2 . "PNAMN-?")))
  (progn
    
    (if
     ( (wcmatch fname "PNAMN*1*")  (STAMP_2) ) 
     ( (wcmatch fname "PNAMN*2*")  (STAMP_2) ) )
   )
))
(princ) 

(setq stamp1 [b][color="red"](strcat[/color][/b] "..\\..\\KOMP_FIL\\Stämpel\\STAMP\\_STAMP-1.dwg"))
[color="red"][b](setq point0 (strcat "0,0,0"))[/b][/color]
(command "-insert" stamp2 point0 "1" "1" "0" "" "" "" "" "" "" "" "" "" "")
)
)