[编程交流] inserting block, counting them

(defun C:REVTAG    (/ ssindexblock lastindexblock inspoint revblockpath blockcount)(setvar "USERI1" (1+ (getvar "USERI1"))) (setq revblockpath (strcat "C:\\PATH\\TO\\_REVTAG.dwg")) (if (setq ssindexblock (ssget "X" '((0 . "INSERT") (2 . "revblockpath"))))   (progn     (setq lastindexblock (entget (ssname ssindexblock 0))       blockcount       (sslength ssindexblock)       inspoint       (polar (cdr (assoc 10 lastindexblock))                 (/ pi 2)                 (* 6.0 blockcount)              ) ;_ end of polar     ) ;_ end of setq   ) ;_ end of progn   (setq inspoint "721.0,202.7,0") ) ;_ end of if (setvar "attdia" 1) (setvar "attreq" 1) (command "_insert" revblockpath inspoint 1.0 1.0 0) (setvar 'useri1 (1+ useri1)) (setvar "attdia" 0) (setvar "attreq" 0)) ;_ end of defun

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:RevTag [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* BDIM BNME ERR FIRST IPT IPTS SS UFLAG[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; Lee Mac  ~  29.01.10[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=#a52a2a]"C:\\PATH\\TO\\_REVTAG.dwg"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] first [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009999]721.0[/color][/b] [b][color=#009999]202.7[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] bDim [b][color=#009999]6.[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b]   [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]   [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b]       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *doc [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]*doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]                            [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]""[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-filename-directory[/color][/b] bNme[b][color=RED])[/color][/b][b][color=RED])[/color][/b]                        [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]tblsearch[/color][/b] [b][color=#a52a2a]"BLOCK"[/color][/b] bNme[b][color=RED])[/color][/b]                            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]findfile[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] bNme [b][color=#a52a2a]".dwg"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]                   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]findfile[/color][/b] bNme[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]          [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** Block Not Found **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]       [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] iPt            [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#a52a2a]"_X"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#a52a2a]"INSERT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]2[/color][/b] bNme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]410[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=DARKRED]'[/color][/b]CTAB[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]              [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]                              [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSelectionSet[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]                  [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] iPts [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get[/color][/b] obj [b][color=DARKRED]'[/color][/b]InsertionPoint[b][color=RED])[/color][/b] iPts[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]                               [b][color=RED]([/color][/b][b][color=BLUE]vla-delete[/color][/b] ss[b][color=RED])[/color][/b]                [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b]                  [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b]                    [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] iPts                      [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]                        [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]a b[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] b[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b] bDim[b][color=RED])[/color][/b][b][color=RED])[/color][/b] first[b][color=RED])[/color][/b][b][color=RED])[/color][/b]          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]          [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-p[/color][/b]                [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] err                  [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vla-InsertBlock[/color][color=RED])[/color][/b]                    [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b]                      [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSpace[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]                        [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PaperSpace[/color][/b] *doc[b][color=RED])[/color][/b]                        [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b]                      [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] iPt[b][color=RED])[/color][/b] bNme [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]            [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-message[/color][/b] err[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]          [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndomark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] C:REVTAG [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] ssindexblock lastindexblock inspoint revblockpath blockcount[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"USERI1"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#a52a2a]"USERI1"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]  [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] revblockpath [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"C:\\PATH\\TO\\_REVTAG.dwg"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; No need to use 'strcat', you are not concatenating any strings[/color][/i]  [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ssindexblock [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#a52a2a]"X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#a52a2a]"INSERT"[/color][/b][b][color=RED])[/color][/b]   [i][color=#990099];; I would recommend using "_X", just for good practice [/color][/i]                                     [b][color=RED]([/color][/b][b][color=#009900]2[/color][/b] . [b][color=#a52a2a]"revblockpath"[/color][/b][b][color=RED])[/color][/b]                                     [i][color=#990099];; This is currently searching for the block[/color][/i]                                     [i][color=#990099];; 'revblockpath' which is not the block you[/color][/i]                                     [i][color=#990099];; are after.[/color][/i]                                     [i][color=#990099];; If you are trying to use the variable here[/color][/i]                                     [i][color=#990099];; you cannot use a string, as the variable will[/color][/i]                                     [i][color=#990099];; not be evaluated. Also, you cannot use an[/color][/i]                                     [i][color=#990099];; apostrophe to declare your list, as the list[/color][/i]                                     [i][color=#990099];; is not evaluated and the variable symbol is taken[/color][/i]                                     [i][color=#990099];; at face value.[/color][/i]                                     [i][color=#990099];; Also, if you were to use the variable, you need t[/color][/i]                                     [i][color=#990099];; use only the block name, not the whole path.[/color][/i]                                     [i][color=#990099];;[/color][/i]                                     [i][color=#990099];; Something like: '((0 . "INSERT") (2 . "_REVTAG"))[/color][/i]                                     [i][color=#990099];; or:[/color][/i]                                     [i][color=#990099];;      (setq block "_REVTAG")[/color][/i]                                     [i][color=#990099];;      (ssget "_X" (list '(0 . "INSERT") (cons 2 block)))[/color][/i]                                     [i][color=#990099];;[/color][/i][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lastindexblock [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ssindexblock [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]           blockcount     [b][color=RED]([/color][/b][b][color=BLUE]sslength[/color][/b] ssindexblock[b][color=RED])[/color][/b]           inspoint       [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] lastindexblock[b][color=RED])[/color][/b][b][color=RED])[/color][/b]                                 [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b]                                 [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=#009999]6.0[/color][/b] blockcount[b][color=RED])[/color][/b]              [b][color=RED])[/color][/b] [i][color=#990099];_ end of polar[/color][/i]     [b][color=RED])[/color][/b] [i][color=#990099];_ end of setq[/color][/i]   [b][color=RED])[/color][/b] [i][color=#990099];_ end of progn[/color][/i]   [i][color=#990099];; This is the first block added to the database, as the[/color][/i]   [i][color=#990099];; ssget "X" mode will scan the database in order, however,[/color][/i]   [i][color=#990099];; I would be inclined to sort the blocks, to make sure you[/color][/i]   [i][color=#990099];; have the point you need.[/color][/i]      [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] inspoint [b][color=#a52a2a]"721.0,202.7,0"[/color][/b][b][color=RED])[/color][/b]      [i][color=#990099];; This is useless if not used with a command call -[/color][/i]   [i][color=#990099];; if you wanted to use this in any other way you would have[/color][/i]   [i][color=#990099];; to separate each element from the comma delimiter and[/color][/i]   [i][color=#990099];; construct the new list.[/color][/i]   [i][color=#990099];; Better to just have:  '(721.0 202.7 0)[/color][/i]   [i][color=#990099];; which can be used everywhere (except in VL) [/color][/i]    [b][color=RED])[/color][/b] [i][color=#990099];_ end of if[/color][/i]  [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"attdia"[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"attreq"[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]command[/color][/b] [b][color=#a52a2a]"_insert"[/color][/b] revblockpath inspoint [b][color=#009999]1.0[/color][/b] [b][color=#009999]1.0[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]  [i][color=#990099];; Watch out when using command calls, they are unreliable, slow[/color][/i] [i][color=#990099];; and are also affected by OSNAP, causing undesired results.[/color][/i] [i][color=#990099];; Better to use either entmake, or vla-insertblock.[/color][/i]  [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=DARKRED]'[/color][/b]useri1 [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] useri1[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"attdia"[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"attreq"[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; Be sure to exit cleanly with (princ), so that[/color][/i] [i][color=#990099];; the last function return is suppressed.[/color][/i] [b][color=RED])[/color][/b] [i][color=#990099];_ end of defun[/color][/i]

(defun c:RevTag (/ *error* BDIM BNME BPATH ERR FIRST IPT IPTS SS UFLAG) (vl-load-com) ;; Lee Mac  ~  29.01.10 (setq bPath "C:\\PATH\\TO\\_REVTAG.dwg") (setq bNme "_REVTAG") (setq first '(721.0 202.7 0) bDim 6.) (defun *error* (msg)   (and uFlag (vla-EndUndoMark *doc))   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")       (princ (strcat "\n** Error: " msg " **")))   (princ))     (setq *doc (cond (*doc) ((vla-get-ActiveDocument                            (vlax-get-acad-object))))) (cond (  (not (or (setq bPath (findfile bPath))                   (and (tblsearch "BLOCK" bNme) (setq bPath bNme))                   (setq bPath (findfile (strcat bNme ".dwg")))))          (princ "\n** Block Not Found **"))       (t (setq iPt            (if (ssget "_X" (list '(0 . "INSERT") (cons 2 bNme) (cons 410 (getvar 'CTAB))))              (progn                              (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))                  (setq iPts (cons (vlax-get obj 'InsertionPoint) iPts)))                               (vla-delete ss)                (polar                  (car                    (vl-sort iPts                      (function                        (lambda (a b) (> (cadr a) (cadr b)))))) (/ pi 2.) bDim)) first))          (setq uFlag (not (vla-StartUndoMark *doc)))          (if (vl-catch-all-error-p                (setq err                  (vl-catch-all-apply (function vla-InsertBlock)                    (list                      (if (zerop (vla-get-ActiveSpace *doc))                        (vla-get-PaperSpace *doc)                        (vla-get-ModelSpace *doc))                      (vlax-3D-point iPt) bPath 1. 1. 1. 0.))))            (princ (vl-catch-all-error-message err)))          (setq uFlag (vla-EndUndomark *doc)))) (princ))