Automatic text numbering
HiTried two lisp routines that work in Autocad for creating or editing to create sequential numbers either directly or from pre existing text.Neither seem to work in V6, although one was supposed to work in Icad 2000.One is Sequence.lsp and the other is ddnumb.lsp, both load OK but do not work.Anyone aware of one that does??Thank you
Comments
-
Is this what your looking for:;Lotno.lsp;
This is a program to insert incremented lot numbers; using current text.;
Created by David Perry 8/15/93;;
Visit http://davescogo.virtualave.net/(defun lotn ( / p p1 p2 n1 scmde) (setq n1 (getint "Enter starting lot number: ")) (setq p1 (getpoint "\nText location: ")) (setq scmde (getvar "cmdecho")) (while p1 (setvar "cmdecho" 0) (setq p2 p1) (if (= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (command "text" "J" "MC" (setq p p1) (setq p "") (setq p "") (setq p n1) ) (command "text" "J" "MC" (setq p p1) (setq p "") (setq p n1) ) );if (setq n1 (+ n1 1)) (setq p1 (getpoint "\nText location: ")) (if (= p1 p2) (setq p1 nil)) ) (setvar "cmdecho" scmde) (princ)) (defun C:LOTNO () (lotn)) (princ "Type LOTNO to begin.") (princ)
0 -
Thank you for the LSP, the lotno works very well and will be very handy. However, also hoping also for the ability to set increments (eg 0.5) and to add pre or postfixes.--So if any other thoughts out there would be much appreciated.
0 -
Another option to write numbers enclosed w/n circles and with accordance to scale of drawing and layer of wish is this lisp routine:;;; Defining Scale for the drawing(DEFUN uvar (/ tmp size) (If (= (GetVar "UserR1") 0) (SetVar "UserR1" (Getreal "\nSCALE.. 1: "))) (SetVar "TEXTSIZE" (* (Getvar "userR1") 0.0017)) (SetVar "DIMTXT" (* (Getvar "userR1") 0.0017)) (SetQ #knm (getvar "userR1")) (SetQ #htxt (getvar "TEXTSIZE")) (Setvar "HPSCALE" (/ #knm 100.0)) (Setvar "ltscale" (/ #knm 100.0)) (SetQ tmp (Getvar "pdmode")) (Cond ((Eq tmp 32) (SetQ size 2.3)) ((Eq tmp 33) (SetQ size 2.3)) (t (SetQ size 1.0) ) ) (SetVar "PDSIZE" (* #knm 0.0005 size)));;; Checking the exsitance of a layer(defun chklayer (layr / ts) (setq ts (tblsearch "LAYER" layr)) (if (null ts) (Princ (strcat "\nBuilding a New Layer " (strcase layr))) (progn (if (= (logand 1 (cdr (assoc 70 ts))) 1) (command "LAYER" "T" layr "") ) ) ) (command "LAYER" "N" layr "")) ; end defun;;; Entering numbers with option to change them(defun uint (bit kwd msg def / inp) (If def ; test for a default (SetQ msg (strcat "\n" msg " <" (itoa def) ">: ") ;string them with default bit (* 2 (fix (/ bit 2))) ;a default and no null bit code ) ;conflict so this reduce bit by 1 (SetQ msg (strcat "\n" msg ": ")) ;if odd, to allow null without default ) ;if (initget bit kwd) (SetQ inp (Getint msg)) (If inp inp def) ;compare the results,return appropiate value) ;defun(defun C:NUM (/ num pt h r ln)(uvar) (SetQ h (* 2.0 #htxt) s t ) (chklayer "1205-TX") (Command "layer" "c" 5 "1205-TX" "") (SetQ yesno (ukword 1 "Yes No" "Add Circle ? [Y/N] " yesno)) (while (/= (SetQ num (uint 5 "" "Number of Lot..: " num)) 999) (SetQ ln (strlen (itoa num)) pt (GetPoint "\nPlace..? ") r (* ln #htxt) ) (entmake (list (cons 0 "text") (cons 8 "1205-TX") (list 10 (car pt) (cadr pt)) (cons 40 h) (cons 1 (itoa num)) (cons 72 4) (list 11 (car pt) (cadr pt)))) (If (Eq yesno "Yes") (entmake (list (cons 0 "CIRCLE") (cons 8 "1205-TX") (list 10 (car pt) (cadr pt)) (cons 40 r))) ) (SetQ num (1+ num)) ))(c:num)
0 -
(SetQ yesno (ukword 1 "Yes No" "Add Circle ? [Y/N] " yesno))ukword ?Is this a combo of initget and getkword ?Program crashes using "ukword".
0 -
Sorry. Forgor to addanother subrouine. Please add the next subroutine to the code of the one I already posted.;* UKWORD User key word. DEF, if any, must match one of the KWD strings;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as;* for INITGET. MSG is the prompt string, to which a default string is added as;* (nil or "" for none), and a : is added.;(defun ukword (bit kwd msg def / inp) (if (and def (/= def "")) ;test for both nil and null string (setq msg (strcat "\n" msg "<" def ">: ") ;string'em with default bit ( 2 (fix (/ bit 2))) ;a default and no null bit code conflict so );setq ;this reduces bit by 1 if odd, to allow null (if (= " " (substr msg (strlen msg) 1)) ;no def, if last char is space (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space (setq msg (strcat "\n" msg ": ")) ;else msg OK ) );if,if (initget bit kwd) ;initialize the key words (setq inp (getkword msg)) ;and use the GET command (if inp inp def) ;compare the results, return appropriate value);defun
0 -
To exit the routine, you can , or enter the nuber 999 when asked for a nuber.
0