Jump to content

autolisp programe for autonumbering


tony barretto

Recommended Posts

;; ============ Num.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text upon mouse click, with optional
;;  prefix and suffix.
;;
;;  SYNTAX: num
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;  VERSION:
;;  1.0  ~  05.04.2009
;;
;; ====================================

(defun c:num1  (/ dVars tmpVars pt ang sNum*)
 (setq dVars '(sNum eNum inNum Spc Dir))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 10 1 1 "X"))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Ending Number <" (rtos eNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Spacing <" (rtos Spc 2 2) ">: "))))
 (initget "X Y")
 (setq tmpVars
   (append tmpVars (list (getkword (strcat "\nSpecify Direction [X/Y] <" Dir ">: ")))))
 (mapcar '(lambda (x y) (or (not x) (set y x))) tmpVars dVars)
 (if (eq Dir "X") (setq ang 0) (setq ang (/ pi 2)))
 (if (setq pt (getpoint "\nSpecify Start Point: ") i 0 sNum* sNum)
   (while (<= sNum* eNum)
     (Make_Text (polar pt ang (* i Spc)) (rtos sNum* 2 2))
     (setq sNum* (+ sNum* inNum) i (1+ i))))
 (princ))

(defun Make_Text  (pt val)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 10 pt)
     (cons 62 2)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 0.0)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt))))

 

 

how can i modify this code so that i can manually select the x and y cordinate for each incremented value .pls get me the modified code

i am using a another program for the same but it not effective above the getint variable my numbering scheme are from 11111 to 99999

Edited by SLW210
Added Code Tags!
Link to comment
Share on other sites

I know there are a few Lisps around for renumbering

 

Lee Mac if i recall has one im sure, check his profile signature, it should be on his site

 

not sure if this is what you are looking for but quite a versatile routine

 

***

 

I believe its called NumInc.lsp

Link to comment
Share on other sites

You want to prompted for the text location until you reach the value from the specified answer to Specify Ending Number ?

 

And yeah, look into Lee Macs Webiste for NumInc function.

 

here's a stripped down version of the code you posted

(defun c:num1 (/ dVars tmpVars pt [b][color=blue]np[/color][/b] ang [color=blue][b]dst[/b][/color] sNum*)
(defun Make_Text (pt val)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 10 pt)
     (cons 62 2)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 0.0)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt)
   )
 )
)
[color=blue][b](setvar 'Dimzin 3)  
[/b][/color](setq dVars '(sNum eNum inNum [color=darkgreen];|Spc Dir|)
[/color](mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 10 1 [color=darkgreen];|1 "X"|;[/color]))
(setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
(getreal (strcat "\nSpecify Ending Number <" (rtos eNum 2 2) ">: "))
(getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
[color=darkgreen];;;(getreal (strcat "\nSpecify Spacing <" (rtos Spc 2 2) ">: "))
[/color]      )
)
[color=darkgreen];;;(initget "X Y")
;;;(setq tmpVars
;;;(append tmpVars (list (getkword (strcat "\nSpecify Direction [X/Y] <" Dir ">: ")))))
[/color](mapcar '(lambda (x y) (or (not x) (set y x))) tmpVars dVars)
(setq i 0 sNum* sNum)
[color=darkgreen];;;(if (eq Dir "X") (setq ang 0) (setq ang (/ pi 2)))
[/color](if [color=blue][b](and[/b][/color] (setq pt (getpoint "\nSpecify Start Point: ") )
     [color=blue][b] (setq np (getpoint pt "\nPick angle and spacing of increment: "))
 (setq ang (angle pt np) dst (distance pt np)))
[/b][/color]  
(while (<= sNum* eNum)
 [color=blue][b](Make_Text pt (rtos sNum* 2 2))
 (setq sNum* (+ sNum* inNum) i (1+ i)
pt (polar pt ang dst ))
[/b][/color]  )
)
(princ))

Edited by pBe
Update Code after more information from OP
Link to comment
Share on other sites

in the above version of the code the numbers are increment for bottom to up how to change the ange to 270degrees so that it can be incremented from top to bottom

secondly i want to to increnment 1.01 by increment factor of +0.1the result is 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 1.1 1.11 1.12 here how can we add a zero to the 1.1 value so all the numbers look aligned.

:D

what i really would like is to choose the xy coordinate position in the drawing for the autoincremented text.

Link to comment
Share on other sites

i am using a another program for the same but it not effective above the getint variable my numbering scheme are from 11111 to 99999

 

I guess that has nothing to do with your request then.

 

in the above version of the code the numbers are increment for bottom to up how to change the ange to 270degrees so that it can be incremented from top to bottom

Change this:

(if (eq Dir "X") (setq ang 0) (setq ang (/ pi 2)))

to this:

(setq ang  (if (eq Dir "X") 0 (* pi 1.5)))

 

secondly i want to to increnment 1.01 by increment factor of +0.1the result is 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 1.1 1.11 1.12 here how can we add a zero to the 1.1 value so all the numbers look aligned.

 

I believe your current dimzin settings is 8

8 Suppresses trailing zeros in decimal dimensions (for example, 12.5000 becomes 12.5)

 

use 0 or 3 (setvar 'Dimzin 3)

 

what i really would like is to choose the xy coordinate position in the drawing for the autoincremented text.

I dont get it.

 

EDIT: See updated code. [patterned after Irnebs code]

Edited by pBe
Link to comment
Share on other sites

Quick one:

(vl-load-com)

(defun MakeText  (pt str / spc hgt)
 (setq spc (apply (cond ((and (not (eq (getvar "CTab") "Model")) (= (getvar "CVport") 1)) 'vla-get-PaperSpace)
                        (t 'vla-get-ModelSpace))
                  (list (vla-get-ActiveDocument (vlax-get-acad-object))))
       hgt (cdr (assoc 40 (tblsearch "STYLE" (getvar "TextStyle")))))
 (if (<= hgt 0.) (setq hgt (getvar "TextSize")))
 (vla-AddText spc str (vlax-3D-point pt) hgt))

(defun rtos-dec (n prec / s d)
 (setq s (rtos n 2 prec)
       d (vl-string-position 46 s))
 (if (> prec 0)
   (progn
     (if (not d) (setq d (strlen s) s (strcat s ".")))
     (repeat (- prec (- (strlen s) d 1)) (setq s (strcat s "0")))))
 s)

(setq *IncStart* 0.0 *IncStop* 10.0 *Inc* 1.0 *IncPrec* 1)
(defun c:IncOnLine (/ start stop inc prec fromPt vector nextPt ss)
 (if (setq start (getreal (strcat "\nEnter start number <" (rtos *IncStart* 2) ">: ")))
   (setq *IncStart* start) (setq start *IncStart*))
 (if (setq stop (getreal (strcat "\nEnter stop number <" (rtos *IncStop* 2) ">: ")))
   (setq *IncStop* stop) (setq stop *IncStop*))
 (if (setq inc (getreal (strcat "\nEnter increment by <" (rtos *Inc* 2) ">: ")))
   (setq *Inc* inc) (setq inc *Inc*))
 (setq inc (* (abs inc) (if (< start stop) 1. -1.)))
 (if (setq prec (getint (strcat "\nEnter number of decimals <" (itoa *IncPrec*) ">: ")))
   (setq *IncPrec* prec) (setq prec *IncPrec*))
 (if (and (setq fromPt (getpoint "\nPick start point: "))
          (setq vector (getpoint fromPt "\nPick angle and spacing of increment: "))
          (setq vector (mapcar '- vector fromPt))
          (setq nextPt fromPt)
          (setq ss (ssadd)))
   (while (cond ((> inc 0.) (< start stop)) ((< inc 0.) (> start stop)))
     (ssadd (vlax-vla-object->ename (MakeText nextPt (rtos-dec start prec))) ss)
     (setq start (+ start inc)
           nextPt (mapcar '+ nextPt vector))))
 (sssetfirst nil ss)
 (princ))

Link to comment
Share on other sites

Irneb.. it stops at 9.00

Maybe:

 (cond ((> inc 0.) ([b][color=blue]<=[/color][/b] start stop)) ((< inc 0.) (> start stop)))

 

(defun rtos-dec (n prec / s d)
....  s)

 

I like it :thumbsup:

Link to comment
Share on other sites

I know the program isn't that great but why did you go to the trouble of stripping my name from my code?

 

;; AUTHOR:

;; Copyright © 2009, Lee McDonnell

;; (Contact Lee Mac, CADTutor.net)

 

No wonder .. who else can think of this construct:

(mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))

 

Back in 2009 that is;

 

:thumbsup:

Link to comment
Share on other sites

Irneb.. it stops at 9.00

Maybe:

 (cond ((> inc 0.) ([b][color=blue]<=[/color][/b] start stop)) ((< inc 0.) (> start stop)))

(defun rtos-dec (n prec / s d)
....  s)

I like it :thumbsup:

Good point! Sorry missed that one! I was more interested in the spacing/direction - in mine it's a one click operation instead of typing distance then X/Y - not that it's wrong doing so, but why?

 

As for the rtos rewrite (or rather mod) ... yes, I thought it better to just fix the adesk stuff-up than fiddle with error traps and setvars.

Link to comment
Share on other sites

firstly sorry for ommitting ur name my apologies

 

sometime i know only the starting no but i may not know the ending no (may be infinite.)e.g. suppose i am doing cable numbering in a circuit drawing,here each incremented number is to be placed manually using my mouse pointer.(value are placed at different points selected by my mouse)

also if i can give some offset to my text value such that say midpoint of a rectangle if i select a endpoint of the rectangle

also set text justification

Edited by tony barretto
yet no reply for my query
Link to comment
Share on other sites

how can i manually select the the point for the incremented value in the drawing

i.e. in my drawing i know only the starting no and may not no the ending no but i want the value to be incremented by 1, after that i would like to manually select the position of every incremented value

what changes can be done to get the above result

Link to comment
Share on other sites

..., after that i would like to manually select the position of every incremented value

what changes can be done to get the above result

That is exactly what all the other Increment routines do. E.g.:

 

Link to comment
Share on other sites

how can i manually select the the point for the incremented value in the drawing

 

Well. the first mod i did on your code (oops LM's code) does that only i used integers. Now i'm starting to think that code you posted have nothing to do with what you want.

 

how to change the ange to 270degrees so that it can be incremented from top to bottom
....value so all the numbers look aligned.
what i really would like is to choose the xy coordinate position in the drawing for the autoincremented text.
...no but i may not know the ending....
placed manually using my mouse pointer.(value are placed at different points selected by my mouse)
i want to to increnment 1.01 by increment factor of +0.1
but i want the value to be incremented 1

 

MAKE UP YOUR MIND!

Link to comment
Share on other sites

  • 2 weeks later...
firstly sorry for ommitting ur name my apologies

 

sometime i know only the starting no but i may not know the ending no (may be infinite.)e.g. suppose i am doing cable numbering in a circuit drawing,here each incremented number is to be placed manually using my mouse pointer.(value are placed at different points selected by my mouse)

also if i can give some offset to my text value such that say midpoint of a rectangle if i select a endpoint of the rectangle

also set text justification

 

Please read the CODE POSTING GUIDELINES then edit your post (be sure to add Lee's header back).

Link to comment
Share on other sites

  • 4 years later...
Quick one:
(vl-load-com)

(defun MakeText  (pt str / spc hgt)
 (setq spc (apply (cond ((and (not (eq (getvar "CTab") "Model")) (= (getvar "CVport") 1)) 'vla-get-PaperSpace)
                        (t 'vla-get-ModelSpace))
                  (list (vla-get-ActiveDocument (vlax-get-acad-object))))
       hgt (cdr (assoc 40 (tblsearch "STYLE" (getvar "TextStyle")))))
 (if (<= hgt 0.) (setq hgt (getvar "TextSize")))
 (vla-AddText spc str (vlax-3D-point pt) hgt))

(defun rtos-dec (n prec / s d)
 (setq s (rtos n 2 prec)
       d (vl-string-position 46 s))
 (if (> prec 0)
   (progn
     (if (not d) (setq d (strlen s) s (strcat s ".")))
     (repeat (- prec (- (strlen s) d 1)) (setq s (strcat s "0")))))
 s)

(setq *IncStart* 0.0 *IncStop* 10.0 *Inc* 1.0 *IncPrec* 1)
(defun c:IncOnLine (/ start stop inc prec fromPt vector nextPt ss)
 (if (setq start (getreal (strcat "\nEnter start number <" (rtos *IncStart* 2) ">: ")))
   (setq *IncStart* start) (setq start *IncStart*))
 (if (setq stop (getreal (strcat "\nEnter stop number <" (rtos *IncStop* 2) ">: ")))
   (setq *IncStop* stop) (setq stop *IncStop*))
 (if (setq inc (getreal (strcat "\nEnter increment by <" (rtos *Inc* 2) ">: ")))
   (setq *Inc* inc) (setq inc *Inc*))
 (setq inc (* (abs inc) (if (< start stop) 1. -1.)))
 (if (setq prec (getint (strcat "\nEnter number of decimals <" (itoa *IncPrec*) ">: ")))
   (setq *IncPrec* prec) (setq prec *IncPrec*))
 (if (and (setq fromPt (getpoint "\nPick start point: "))
          (setq vector (getpoint fromPt "\nPick angle and spacing of increment: "))
          (setq vector (mapcar '- vector fromPt))
          (setq nextPt fromPt)
          (setq ss (ssadd)))
   (while (cond ((> inc 0.) (< start stop)) ((< inc 0.) (> start stop)))
     (ssadd (vlax-vla-object->ename (MakeText nextPt (rtos-dec start prec))) ss)
     (setq start (+ start inc)
           nextPt (mapcar '+ nextPt vector))))
 (sssetfirst nil ss)
 (princ))

 

hey all, first off - sorry for resurrecting an old thread but on the above lisp routine, how do you add text justification? I have an old routine that is similar from a guy I used to work with (author in the routine below) but the routine doesn't work anymore and I have no clue how to fix it...any help would be greatly appreciated (i started using autocad back in the day (rel. 9) but never picked up writing routines) - thanks again!

 

;==[ ???.lsp ]==========================================================
; Louis A. Mancuso - M-E-I Consultants, Inc.
; October 18, 1995
;
(setq LISPERROR "MNum.lsp")
;--[ Description ]------------------------------------------------------
;
;--[ Revision History ]-------------------------------------------------
; 06/01/92      Version 1.0     Prototype Lisp used for initial release.
; 04/13/94	Version 1.1     Removed the prompting fot text height.
;>01/31/95	Version 2.0	Made any modifications for Rel. 13.
; 10/18/95	Version 2.1	Fixed style problem.
;
;--[ Version ]----------------------------------------------------------
(setq MNUM_VER "     MNU: Version 2.2c4")
;
;--[ External Commands ]------------------------------------------------
; Function   LISPFILE.lsp   Description
;---------- -------------- ---------------------------------------------
; dtr                       Degrees to Radian
;
;=======================================================================
;--[[Main Function]-----------------------------------------------------
(defun c:MNUM ( )
(setvar "cmdecho" 0)
(prompt (strcat "\n" MNum_Ver))
(command "undo" "m")
 (setq TSTYLE "standard")
 (setq TSPACE (getdist "\nDistance between numbers: "))
 (initget "Down Right")
 (setq DIRECTION (getkword "\nText direction angle: Down/Right <Down>: "))
 (cond
  ((= DIRECTION nil) (setq DIRECTION "Down"))
 )
 (if (= DIRECTION "Down")
  (progn (setq DIRECTION 270) (setq TXTANG 0))
  (progn (setq DIRECTION 0)   (setq TXTANG 90)
  )
 )
 (setq SNUM (getint "\nStarting number: "))
 (setq INC (getint "\nIncrease numbers by: "))
 (setq TNUM (getint "\nHow many numbers do you want to show: "))
 (prompt "\n               TL TC TR")
 (prompt "\nJustification: ML MC MR")
 (setq JUST (getstring "\n               BL BC BR <L>: "))
  (if (= JUST "") (setq JUST nil))
 (setq PT1 (getpoint "\nLocate start point of first number: "))
 (setq ST 1)
 (while (<= ST TNUM)
  (if (null JUST)
   (command "text" "s" TSTYLE PT1 TXTANG SNUM)
   (command "text" "s" TSTYLE JUST PT1 TXTANG SNUM)
  )
  (setq SNUM (+ SNUM INC))
  (setq ST (1+ ST))
  (setq PT1 (polar PT1 (dtr DIRECTION) TSPACE))
 )
(setvar "cmdecho" 1)
(princ)
)

;==[ End of File: ???.lsp ]=============================================

 

edit to follow posting guidelines - my apologies

Edited by plthijnx
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...