Jump to content

Is there a Numbering Command in acad(07)?

vector

By vector
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

vector Rookie

vector

Posted
Posted

Hi everyone !!!I would like to know if there is such a command in AutoCAD (2007)?A command that creates inclining numbering with every click on an object it adds new number , the next new number is higher with 1 (+1) than the current , and it supposed to prompt the user to give a value to the first number in a series . Thanke a lot in advance GM

  • Replies 32
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    9

  • CAB

    7

  • tzframpton

    7

  • mdbdesign

    4

Popular Days

Top Posters In This Topic

Popular Days

wannabe Experienced

wannabe

Posted
Posted

Vector, are you also a MicroStation user?

Lee Mac Grand Master

Lee Mac

Posted
Posted

Was bored, so made ya this one :)

 

;; ============ 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:num  (/ vlst ovar stmp intmp ptmp sutmp vars pt)
 (setq    vlst   '("OSMODE" "CLAYER")
   ovar   (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)
 (or (tblsearch "LAYER" "NumText")
     (vla-add (vla-get-layers
        (vla-get-ActiveDocument
          (vlax-get-acad-object)))
          "NumText"))
 (or sNum (setq sNum 1))
 (or inNum (setq inNum 1))
 (or Pref (setq Pref ""))
 (or Suff (setq Suff ""))
 (setq    stmp (getreal (strcat "\nSpecify Starting Number <" (rtos sNum) ">: "))
   intmp(getreal (strcat "\nSpecify Increment <" (rtos inNum) ">: "))
   ptmp (getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
   sutmp(getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: ")))
 (or (not stmp) (setq sNum stmp))
 (or (not intmp) (setq inNum intmp))
 (or (eq "" ptmp) (setq Pref ptmp))
 (or (eq "" sutmp) (setq Suff sutmp))
 (while (setq pt (getpoint "\nClick for Text... "))
   (Make_Text pt (strcat Pref (rtos sNum) Suff))
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (princ))

(defun Make_Text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
        '(8 . "NumText")
        (cons 10 txt_pt)
        (cons 40 (max 2.5 (getvar "TEXTSIZE")))
        (cons 1 txt_val)
        '(50 . 0.0)
        (cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)
        (cons 11 txt_pt))))

mdbdesign Experienced

mdbdesign

Posted
Posted

Text looks like: pref 1" suffix. " mark is what you plan to achieve?

Lee Mac Grand Master

Lee Mac

Posted
Posted
Text looks like: pref 1" suffix. " mark is what you plan to achieve?

 

Are you querying my code Mdb? - if so, yes, I thought the user may want a prefix and/or suffix, eg

 

A10CB

A11CB

etc etc

 

I only wrote it quickly - can easily be modified :)

mdbdesign Experienced

mdbdesign

Posted
Posted

Prefix and suffix is OK. Just " mark looks like: 1 inch, 2 inches.(A10"CB;A11"CB)

Lee Mac Grand Master

Lee Mac

Posted
Posted
Prefix and suffix is OK. Just " mark looks like: 1 inch, 2 inches.(A10"CB;A11"CB)

 

 

Hmmm... there shouldn't be any quotation marks - will investigate this one.. :P :P

Tankman Grand Master

Tankman

Posted
Posted

You might like callout.lsp.

 

A simple program, has been changed numerous times to suit the end-users requirements (needs).

Callout.lsp

Lee Mac Grand Master

Lee Mac

Posted
Posted

I think the quotation marks were due to your units setting being in imperial and not metric, but this should work for you :)

 

;; ============ 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:num  (/ vlst ovar dVars tmpVars pt)
 (setq    vlst '("OSMODE" "CLAYER")
   ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)
 (or (tblsearch "LAYER" "NumText")
     (vla-put-color
   (vla-add
     (vla-get-layers
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) "NumText") acYellow))
 (setq dVars '(sNum inNum Pref Suff))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
             (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
             (getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
             (getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
 (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
 (while (setq pt (getpoint "\nClick for Text... "))
   (Make_Text pt (strcat Pref (rtos sNum 2 2) Suff))
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (princ))

(defun Make_Text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
        '(8 . "NumText")
        (cons 10 txt_pt)
        (cons 40 (max 2.5 (getvar "TEXTSIZE")))
        (cons 1 txt_val)
        '(50 . 0.0)
        (cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)
        (cons 11 txt_pt))))

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok, hows this :P :P

 

;; ============ NumCur.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text at the end of a leader, upon
;;  mouse click.
;;
;;  SYNTAX: numCur
;;
;;  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:numCur (/ *error* vlst ovar doc spc dVars
          tmpVars cObj tBox GLst mPos cPt
          cDis EnPt ArPt1 ArPt2 AngCor vCol
          Verts VertVar )
 
 (vl-load-com)

 (defun *error* (msg)
   (redraw)
   (if ovar (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError: " (strcase msg)))
     (princ "\n<<-- cancelled -->>"))
   (princ))

 (setq vlst '("OSMODE" "CLAYER")
   ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)

 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (or (tblsearch "LAYER" "Num-Text")
     (vla-put-color
   (vla-add
     (vla-get-layers doc) "NumText") acYellow))
 (setq dVars '(sNum inNum Pref Suff))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
             (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
             (getstring t (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
             (getstring t (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
 (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
 (while (and (setq cEnt (car (entsel "\nSelect Curve to Label: ")))
         (member (cdr (assoc 0 (entget cEnt)))
           '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "ELLIPSE" "CIRCLE")))
   (vla-EndUndoMark doc)
   (vla-StartUndomark doc)
   (setq cObj (vlax-ename->vla-object cEnt)
     tBox (textbox (list (cons 1 (setq tStr (strcat Pref (rtos sNum 2 0) Suff))))))
   (princ "\nSelect Location for Leader... ")
   (while (= (car (setq GLst (grread T 1))) 5)
     (redraw)
     (if (= (type (setq mPos (cadr GLst))) 'list)
   (progn
     (setq cPt (vlax-curve-getClosestPointto cObj mPos)
       cAng (angle cPt mPos)
       cDis (distance cPt mPos)
       EnPt (polar cPt cAng (/ cDis 1.5))
       ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0))
       ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0))
       AngCor (fix (abs (* 10.0 (fix (* 18.0 (/ cAng pi)))))))
     (or (and (< AngCor 1.0) (setq vCol 1)) (setq vCol AngCor))
     (grvecs (list vCol cPt EnPt vCol cPt ArPt1 vCol cPt ArPt2)))))
   (princ "\nSelect Leader Size & Angle...")
   (while (= (car (setq GLst (grread T 1))) 5)
     (redraw)
     (if (= (type (setq mPos (cadr GLst))) 'list)
   (progn
     (setq cAng (angle cPt mPos)
       cDis (distance cPt mPos)
       ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0))
       ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0)))
     (grvecs (list vCol cPt mPos vCol cPt ArPt1 vCol cPt ArPt2)))))
   (setq Verts (apply 'append (list cPt mPos))
     VertVar (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
           vlax-vbdouble
           (cons 0 (1- (length Verts))))
             Verts)))
   (vla-addleader spc VertVar
     (vla-addMText spc
   (vlax-3d-Point
     (polar mPos 0 (/ (getvar "TEXTSIZE") 2.0)))
   (- (caadr tBox) (caar tBox)) tStr) acLineWithArrow)
   (redraw)
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (redraw)
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted
Don't forget TCOUNT in ExpressTools

 

Never knew that was there - fantastic command as well! :thumbsup:

Lee Mac Grand Master

Lee Mac

Posted
Posted

Actually this is better (colourwise):

 

;; ============ NumCur.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text at the end of a leader, upon
;;  mouse click.
;;
;;  SYNTAX: numCur
;;
;;  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:numCur (/ *error* vlst ovar doc spc dVars
          tmpVars cObj tBox GLst mPos cPt
          cDis EnPt ArPt1 ArPt2 AngCor vCol
          Verts VertVar )
 
 (vl-load-com)

 (defun *error* (msg)
   (redraw)
   (if ovar (mapcar 'setvar vlst ovar))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError: " (strcase msg)))
     (princ "\n<<-- cancelled -->>"))
   (princ))

 (setq vlst '("OSMODE" "CLAYER")
   ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)

 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (or (tblsearch "LAYER" "Num-Text")
     (vla-put-color
   (vla-add
     (vla-get-layers doc) "NumText") acYellow))
 (setq dVars '(sNum inNum Pref Suff))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
             (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
             (getstring t (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
             (getstring t (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
 (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
 (while (and (setq cEnt (car (entsel "\nSelect Curve to Label: ")))
         (member (cdr (assoc 0 (entget cEnt)))
           '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "ELLIPSE" "CIRCLE")))
   (vla-EndUndoMark doc)
   (vla-StartUndomark doc)
   (setq cObj (vlax-ename->vla-object cEnt)
     tBox (textbox (list (cons 1 (setq tStr (strcat Pref (rtos sNum 2 0) Suff))))))
   (princ "\nSelect Location for Leader... ")
   (while (= (car (setq GLst (grread T 1))) 5)
     (redraw)
     (if (= (type (setq mPos (cadr GLst))) 'list)
   (progn
     (setq cPt (vlax-curve-getClosestPointto cObj mPos)
       cAng (angle cPt mPos)
       cDis (distance cPt mPos)
       EnPt (polar cPt cAng (/ cDis 1.5))
       ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0))
       ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0))
       AngCor (fix (rem (abs (* 10.0 (fix (* 18.0 (/ cAng pi))))) 255.0)))
     (or (and (< AngCor 1.0) (setq vCol 1)) (setq vCol AngCor))
     (grvecs (list vCol cPt EnPt vCol cPt ArPt1 vCol cPt ArPt2)))))
   (princ "\nSelect Leader Size & Angle...")
   (while (= (car (setq GLst (grread T 1))) 5)
     (redraw)
     (if (= (type (setq mPos (cadr GLst))) 'list)
   (progn
     (setq cAng (angle cPt mPos)
       cDis (distance cPt mPos)
       ArPt1 (polar cPt (+ cAng (/ pi 12)) (/ cDis 8.0))
       ArPt2 (polar cPt (- cAng (/ pi 12)) (/ cDis 8.0)))
     (grvecs (list vCol cPt mPos vCol cPt ArPt1 vCol cPt ArPt2)))))
   (setq Verts (apply 'append (list cPt mPos))
     VertVar (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
           vlax-vbdouble
           (cons 0 (1- (length Verts))))
             Verts)))
   (vla-addleader spc VertVar
     (vla-addMText spc
   (vlax-3d-Point
     (polar mPos 0 (/ (getvar "TEXTSIZE") 2.0)))
   (- (caadr tBox) (caar tBox)) tStr) acLineWithArrow)
   (redraw)
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (redraw)
 (princ))

tzframpton Grand Master

tzframpton

Posted
Posted

CAB has an excellent one over at theswamp.org that my office uses on a daily basis. :)

Lee Mac Grand Master

Lee Mac

Posted
Posted

I just like messing around with the GRREAD, GRVECS etc commands :)

mdbdesign Experienced

mdbdesign

Posted
Posted

What is file name of CAB routine?

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.

×
 Share
Go to topic listing
×
×
  • Create New...