inserting block, counting them
Hi,I have this lisp I am trying to manipulate.
I am inserting a block called _REVTAG into a drawing (paperspace).
What I want it to do is that I give first coordinates for this block to be inserted which are:
(setq inspoint "721.0,202.7,0")
If I insert this block again (it's a revision block by the way) I want i to count X times it has been inserted and when ie it has been inserted once before it will count the height of this block which is 6mm and then it will insert it 6mm above previous insertion which should be 721.0,208.7,0.
If I insert the same block 4 times it counts the height and insert it 3x6mm above first insertion.
Thsi is the lisp I can't get working:
(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 Try this:
(defun c:RevTag (/ *error* BDIM BNME ERR FIRST IPT IPTS SS UFLAG) (vl-load-com) ;; Lee Mac~29.01.10 (setq bNme "C:\\PATH\\TO\\_REVTAG.dwg") (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 (and (eq "" (vl-filename-directory bNme)) (or (tblsearch "BLOCK" bNme) (setq bNme (findfile (strcat bNme ".dwg"))))) (setq bNme (findfile bNme)))) (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) bNme 1. 1. 1. 0.)))) (princ (vl-catch-all-error-message err))) (setq uFlag (vla-EndUndomark *doc)))) (princ)) Au-S,
Please carefully read the comments I have added to your routine, and also perhaps study my code so that you may know where you were going wrong.
(defun C:REVTAG (/ ssindexblock lastindexblock inspoint revblockpath blockcount) (setvar "USERI1" (1+ (getvar "USERI1")))(setq revblockpath (strcat "C:\\PATH\\TO\\_REVTAG.dwg")) ;; No need to use 'strcat', you are not concatenating any strings(if (setq ssindexblock (ssget "X" '((0 . "INSERT") ;; I would recommend using "_X", just for good practice (2 . "revblockpath") ;; This is currently searching for the block ;; 'revblockpath' which is not the block you ;; are after. ;; If you are trying to use the variable here ;; you cannot use a string, as the variable will ;; not be evaluated. Also, you cannot use an ;; apostrophe to declare your list, as the list ;; is not evaluated and the variable symbol is taken ;; at face value. ;; Also, if you were to use the variable, you need t ;; use only the block name, not the whole path. ;; ;; Something like: '((0 . "INSERT") (2 . "_REVTAG")) ;; or: ;; (setq block "_REVTAG") ;; (ssget "_X" (list '(0 . "INSERT") (cons 2 block))) ;;))) (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 ;; This is the first block added to the database, as the ;; ssget "X" mode will scan the database in order, however, ;; I would be inclined to sort the blocks, to make sure you ;; have the point you need. (setq inspoint "721.0,202.7,0") ;; This is useless if not used with a command call - ;; if you wanted to use this in any other way you would have ;; to separate each element from the comma delimiter and ;; construct the new list. ;; Better to just have:'(721.0 202.7 0) ;; which can be used everywhere (except in VL) ) ;_ end of if(setvar "attdia" 1) (setvar "attreq" 1) (command "_insert" revblockpath inspoint 1.0 1.0 0);; Watch out when using command calls, they are unreliable, slow ;; and are also affected by OSNAP, causing undesired results. ;; Better to use either entmake, or vla-insertblock.(setvar 'useri1 (1+ useri1)) (setvar "attdia" 0) (setvar "attreq" 0) ;; Be sure to exit cleanly with (princ), so that ;; the last function return is suppressed. ) ;_ end of defun Thanx.
This code you gave me works fine allthough it do not insert it above the previous inserted block.
It inserts it with the same insertion point.
Thanx for the comments by the way
(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))
Apologies, I used the block path in the SelSet Wonderfull piece of code...
I will study it now row by row.
Thank you Sir
You're welcome
页:
[1]