非常健壮的lisp 乐筑天下 - Powered by Discuz! Archiver

JDRBWA 发表于 2022-7-6 12:05:19

更新版本-愚蠢的我忘记设置cmdecho

(defun c:tagger (/ *error* vLst oVars ans pTxt sTxt cnt iPt drTag bubTag drTagLst
         bubTagLst lAns 1pt 2pt lAng chrLst sChr)
(vl-load-com)
(defun *error*(msg)
(if oVars
(mapcar 'setvar vLst oVars))
(if (eq "" msg)
(princ "\n<< Function Complete >>")
(princ (strcat "Error: " (strcase msg))))
(princ))
(setq vLst(list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE")
oVars (mapcar 'getvar vLst))
(mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2"))
(if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01"))
(progn
(if (not TG:oans)
(setq TG:oans "Door"))
(if (not TG:olans)
(setq TG:olans "Yes"))
(initget "Door Bubble")
(setq ans (getkword (strcat "\nSpecify Tag Type <" TG:oans ">: ")))
(if (not ans)
(setq ans TG:oans)
(setq TG:oans ans))
(if (and (setq pTxt (getstring t "\nSpecify Prefix Text <Enter for no Prefix>:"))
      (not (initget 5))
      (setq sNum (getint "\nSpecify Starting Number: ")
         sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:")))
(progn
(setq cnt 0)
(mapcar 'setvar vLst (list 0 "0" 0 0))
(cond ((= ans "Bubble")
   (initget "Yes No")
   (setq lAns (getkword (strcat "\nGrid-Line? <" TG:olans ">: ")))
   (if (not lAns)
      (setq lAns TG:olans)
      (setq TG:olans lAns))
   (cond ((= lAns "No")
      (while (setq iPt (getpoint "\nSelect Point for Symbol > "))
         (setvar "clayer" "S-GRID-IDEN")
         (command "-insert" "Grdbub01" iPt "" "" "")
         (setq bubTag (entnext (entlast)))
         (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag))))
            (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst)))
            (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
                     (assoc 1 bubTagLst)
                     bubTagLst)))
            (setq bubTag (entnext bubTag)))
         (command "_regenall")
         (setq cnt (1+ cnt))))
         ((= lAns "Yes")
      (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > "))
               (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > ")))
         (setvar "clayer" "S-GRID")
         (command "_line" 1pt 2pt "")
         (setq grLin (entlast)
            lAng(angle 1pt 2pt)
            iPt (polar 2pt lAng 0.5))
         (setvar "clayer" "S-GRID-IDEN")
         (command "-insert" "Grdbub01" iPt "" "" "")
         (setq bubTag (entnext (entlast)))
         (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag))))
            (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst)))
            (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
                     (assoc 1 bubTagLst)
                     bubTagLst)))
            (setq bubTag (entnext bubTag)))
         (command "_regenall")
         (setq cnt (1+ cnt))))))
   ((= ans "Door")
   (setq chrLst (vl-string->list sTxt))
   (if chrLst
      (setq sChr (last chrLst))
      (setq sChr 65))
   (while (and (setq iPt (getpoint "\nSelect Point for Symbol > "))
            (< (+ sChr cnt) 91))
      (setvar "clayer" "A-DOOR-IDEN")
      (command "-insert" "Tagdoor1" iPt "" "" "")
      (setq drTag (entnext (entlast)))
      (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag))))
         (if (= "DR1NUM" (cdr (assoc 2 drTagLst)))
         (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt))))
                  (assoc 1 drTagLst)
                  drTagLst)))
         (setq drTag (entnext drTag)))
      (command "_regenall")
      (setq cnt (1+ cnt))))))))
(princ "\n<!> One or More Blocks not Found <!>"))
(*error* "")
(princ))

(defun makelay (x y)
(if (not (tblsearch "LAYER" x))
(command "-layer" "M" x "C" y x "")))

Lee Mac 发表于 2022-7-6 12:09:14

如果它确实是您希望块引用的文件路径，请确保使用双反斜杠将突出显示的部分填充到每个块的正确文件路径（一直到文件级）。

即

C： \\Users\\LeeMac\\Documents\\Block1。图纸

(defun c:tagger (/ *error* vLst oVars ans pTxt sTxt cnt iPt drTag bubTag drTagLst bubTagLst lAns 1pt 2pt lAng chrLst
      sChr)
(vl-load-com)
(defun *error*(msg)
(if oVars
(mapcar 'setvar vLst oVars))
(if (eq "" msg)
(princ "\n<< Function Complete >>")
(princ (strcat "Error: " (strcase msg))))
(princ))
(setq vLst(list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE" "CMDECHO")
oVars (mapcar 'getvar vLst))
(mapcar 'setvar vLst (list 0 "0" 0 0 0))
(mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2"))
(if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01"))
(progn
(if (not TG:oans)
(setq TG:oans "Door"))
(if (not TG:olans)
(setq TG:olans "Yes"))
(initget "Door Bubble")
(setq ans (getkword (strcat "\nSpecify Tag Type <" TG:oans ">: ")))
(if (not ans)
(setq ans TG:oans)
(setq TG:oans ans))
(if (and (setq pTxt (getstring t "\nSpecify Prefix Text <Enter for no Prefix>:"))
      (not (initget 5))
      (setq sNum (getint "\nSpecify Starting Number: ")
         sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:")))
(progn
(setq cnt 0)
(cond ((= ans "Bubble")
   (initget "Yes No")
   (setq lAns (getkword (strcat "\nGrid-Line? <" TG:olans ">: ")))
   (if (not lAns)
      (setq lAns TG:olans)
      (setq TG:olans lAns))
   (cond ((= lAns "No")
      (while (setq iPt (getpoint "\nSelect Point for Symbol > "))
         (setvar "clayer" "S-GRID-IDEN")
         (command "-insert" "Grdbub01" iPt "" "" "")
         (setq bubTag (entnext (entlast)))
         (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag))))
            (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst)))
            (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
                     (assoc 1 bubTagLst)
                     bubTagLst)))
            (setq bubTag (entnext bubTag)))
         (command "_regenall")
         (setq cnt (1+ cnt))))
         ((= lAns "Yes")
      (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > "))
               (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > ")))
         (setvar "clayer" "S-GRID")
         (command "_line" 1pt 2pt "")
         (setq grLin (entlast)
            lAng(angle 1pt 2pt)
            iPt (polar 2pt lAng 0.5))
         (setvar "clayer" "S-GRID-IDEN")
         (command "-insert" "Grdbub01" iPt "" "" "")
         (setq bubTag (entnext (entlast)))
         (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag))))
            (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst)))
            (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
                     (assoc 1 bubTagLst)
                     bubTagLst)))
            (setq bubTag (entnext bubTag)))
         (command "_regenall")
         (setq cnt (1+ cnt))))))
   ((= ans "Door")
   (setq chrLst (vl-string->list sTxt))
   (if chrLst
      (setq sChr (last chrLst))
      (setq sChr 65))
   (while (and (setq iPt (getpoint "\nSelect Point for Symbol > "))
            (< (+ sChr cnt) 91))
      (setvar "clayer" "A-DOOR-IDEN")
      (command "-insert" "Tagdoor1" iPt "" "" "")
      (setq drTag (entnext (entlast)))
      (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag))))
         (if (= "DR1NUM" (cdr (assoc 2 drTagLst)))
         (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt))))
                  (assoc 1 drTagLst)
                  drTagLst)))
         (setq drTag (entnext drTag)))
      (command "_regenall")
      (setq cnt (1+ cnt))))))))
(princ "\n<!> One or More Blocks not Found <!>"))
(*error* "")
(princ))

(defun makelay (x y)
(if (not (tblsearch "LAYER" x))
(command "-layer" "M" x "C" y x "")))

JDRBWA 发表于 2022-7-6 12:11:30

把“起始数字”设为字母/数字有多难？

所以在网格泡泡中，我可以有一个AA，BB，CC之类的东西

Lee Mac 发表于 2022-7-6 12:15:35

那么你想选择使用递增字母和数字吗？

你还需要使用前缀和后缀吗？

JDRBWA 发表于 2022-7-6 12:17:45

Lee Mac 发表于 2022-7-6 12:20:58

I can point it to the block filepath, or leave the filepath blank for you to fill in

Lee Mac 发表于 2022-7-6 12:24:57

An updated version - silly me forgot to set the cmdecho

(defun c:tagger (/ *error* vLst oVars ans pTxt sTxt cnt iPt drTag bubTag drTagLst bubTagLst lAns 1pt 2pt lAng chrLst sChr) (vl-load-com) (defun *error*(msg) (if oVars (mapcar 'setvar vLst oVars)) (if (eq "" msg) (princ "\n>") (princ (strcat "Error: " (strcase msg)))) (princ)) (setq vLst(list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE" "CMDECHO") oVars (mapcar 'getvar vLst)) (mapcar 'setvar vLst (list 0 "0" 0 0 0)) (mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2")) (if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01")) (progn (if (not TG:oans) (setq TG:oans "Door")) (if (not TG:olans) (setq TG:olans "Yes")) (initget "Door Bubble") (setq ans (getkword (strcat "\nSpecify Tag Type : "))) (if (not ans) (setq ans TG:oans) (setq TG:oans ans)) (if (and (setq pTxt (getstring t "\nSpecify Prefix Text :")) (not (initget 5)) (setq sNum (getint "\nSpecify Starting Number: ") sTxt (getstring t "\nSpecify Suffix Text :"))) (progn (setq cnt 0) (cond ((= ans "Bubble") (initget "Yes No") (setq lAns (getkword (strcat "\nGrid-Line? : "))) (if (not lAns) (setq lAns TG:olans) (setq TG:olans lAns)) (cond ((= lAns "No") (while (setq iPt (getpoint "\nSelect Point for Symbol > ")) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) ((= lAns "Yes") (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > "))) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng(angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))))) ((= ans "Door") (setq chrLst (vl-string->list sTxt)) (if chrLst (setq sChr (last chrLst)) (setq sChr 65)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr cnt) 91)) (setvar "clayer" "A-DOOR-IDEN") (command "-insert" "Tagdoor1" iPt "" "" "") (setq drTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag)))) (if (= "DR1NUM" (cdr (assoc 2 drTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt)))) (assoc 1 drTagLst) drTagLst))) (setq drTag (entnext drTag))) (command "_regenall") (setq cnt (1+ cnt)))))))) (princ "\n One or More Blocks not Found ")) (*error* "") (princ))(defun makelay (x y) (if (not (tblsearch "LAYER" x)) (command "-layer" "M" x "C" y x "")))

Lee Mac 发表于 2022-7-6 12:26:20

If it is indeed a filepath you would like the blocks referenced to, make sure you fill in the highlighted Parts to the correct Filepaths for each block (right down to the file level), using double backslashes.

i.e.

C:\\Users\\LeeMac\\Documents\\Block1.dwg

(defun c:tagger (/ *error* vLst oVars DoorBlock BubbleBlock ans pTxt sTxt cnt iPt drTag bubTag drTagLst bubTagLst lAns 1pt 2pt lAng chrLst sChr) (vl-load-com) (defun *error*(msg) (if oVars (mapcar 'setvar vLst oVars)) (if (eq "" msg) (princ "\n>") (princ (strcat "Error: " (strcase msg)))) (princ)) (setq vLst(list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE" "CMDECHO") oVars (mapcar 'getvar vLst)) (mapcar 'setvar vLst (list 0 "0" 0 0 0)) (mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2")) (setq DoorBlock "C:\\..." BubbleBlock "C:\\...") (if (and DoorBlock BubbleBlock) (progn (if (not TG:oans) (setq TG:oans "Door")) (if (not TG:olans) (setq TG:olans "Yes")) (initget "Door Bubble") (setq ans (getkword (strcat "\nSpecify Tag Type : "))) (if (not ans) (setq ans TG:oans) (setq TG:oans ans)) (if (and (setq pTxt (getstring t "\nSpecify Prefix Text :")) (not (initget 5)) (setq sNum (getint "\nSpecify Starting Number: ") sTxt (getstring t "\nSpecify Suffix Text :"))) (progn (setq cnt 0) (cond ((= ans "Bubble") (initget "Yes No") (setq lAns (getkword (strcat "\nGrid-Line? : "))) (if (not lAns) (setq lAns TG:olans) (setq TG:olans lAns)) (cond ((= lAns "No") (while (setq iPt (getpoint "\nSelect Point for Symbol > ")) (setvar "clayer" "S-GRID-IDEN") (command "-insert" BubbleBlock iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) ((= lAns "Yes") (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > "))) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng(angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" BubbleBlock iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))))) ((= ans "Door") (setq chrLst (vl-string->list sTxt)) (if chrLst (setq sChr (last chrLst)) (setq sChr 65)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr cnt) 91)) (setvar "clayer" "A-DOOR-IDEN") (command "-insert" DoorBlock iPt "" "" "") (setq drTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag)))) (if (= "DR1NUM" (cdr (assoc 2 drTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt)))) (assoc 1 drTagLst) drTagLst))) (setq drTag (entnext drTag))) (command "_regenall") (setq cnt (1+ cnt)))))))) (princ "\n One or More Blocks not Found ")) (*error* "") (princ))(defun makelay (x y) (if (not (tblsearch "LAYER" x)) (command "-layer" "M" x "C" y x "")))

JDRBWA 发表于 2022-7-6 12:28:55

How hard is it to take the "starting number" and let it be alpha/numeric?

So that inside the grid bubbles I can have an AA, BB, CC kinda thing

Lee Mac 发表于 2022-7-6 12:31:50

So you would like the option of using incremental letters as well as numbers?

Would you still require the use of Prefixes and Suffixes?

页: 1 [2]

乐筑天下's Archiver