Topic: Text Incriment

[V-Man]

I have this code to place text and incriments as it goes.

Ex. If I type in 01001 ,  the routine gives 1001

I want the 0 before the 1 so that it reads 01001
How can I get this to do that?

Code: [Select]

   (defun C:ADD (/ startc pt)
   (setvar "cmdecho" 0)
   (prompt "\nUse text style with height zero to run this program")
   (if (not start)(setq start 01))
   (setq startc (getint (strcat "\nStarting number <" (itoa start) ">: ")))
   (setq pt (getpoint "\nFirst Point: "))
   (if startc (setq start startc))
       (while pt
           (command ".text" "M" pt "" "" (itoa start))
           (setq start (1+ start))
           (setq pt (getpoint (strcat "\nNext point "(itoa start)": ")))
       );while
   (princ)
)


[ronjonp]

A quick fix is to use strcat....but then the 0 prefix is always hardcoded in:

Code: [Select]

(defun C:ADD (/ startc pt)
  (setvar "cmdecho" 0)
  (prompt
    "\nUse text style with height zero to run this program"
  )
  (if (not start)
    (setq start 01)
  )
  (setq
    startc (getint (strcat "\nStarting number <" (strcat "0" (itoa start)) ">: "))
  )
  (setq pt (getpoint "\nFirst Point: "))
  (if startc
    (setq start startc)
  )
  (while pt
    (command ".text" "M" pt "" "" (strcat "0" (itoa start)))
    (setq start (1+ start))
    (setq pt (getpoint (strcat "\nNext point " (strcat "0" (itoa start)) ": ")))
  ) ;while
  (princ)
)
*added code tags*

[Bob Wahr]

yeah, without lisping at all here's a way to go playing off of ronjonp

[psuedocode]
if the right most digit is not 9
  leave everything except the right most digit as a string
else move one digit left until the number is not a 9

then convert right most digits to an integer
  integer = integer +1
[/psuedocode]

[ronjonp]

Here is a rewrite with a prefix option and fixes the text height issue if it's not set to 0.

Code: [Select]

(defun C:ADD (/ startc prefixc pt)
  (defun rjp-addtext (ins hgt txt /)
    (entmake (list (cons 0 "TEXT")
   (cons 10 (trans ins 1 0))
   (cons 40
(if (= (getvar 'tilemode) 1)
   (* (getvar 'dimscale) hgt)
   hgt
)
   )
   (cons 1 txt)
     )
    )
  )
  (setvar "cmdecho" 0)
  (if (not prefix)
    (setq prefix "")
  )
  (if (not start)
    (setq start 1)
  )
  (setq
    prefixc (getstring (strcat "\nPrefix <"
       prefix
       ">: "
       )
    )
  )
  (if (/= prefixc "")
    (setq prefix prefixc)
  )
  (setq
    startc (getint (strcat "\nStarting number <"
   (strcat prefix (itoa start))
   ">: "
   )
   )
  )
  (setq pt (getpoint "\nFirst Point: "))
  (if startc
    (setq start startc)
  )
  (while pt
    (rjp-addtext pt 0.125 (strcat prefix (itoa start)))
    (setq start (1+ start))
    (setq
      pt (getpoint
   (strcat "\nNext point " (strcat prefix (itoa start)) ": ")
)
    )
  ) ;while
  (princ)
)
*code modified to remember prefix*

[V-Man]

(defun C:ADD (/ startc prefixc pt)
  (defun rjp-addtext (ins hgt txt /)
    (entmake (list (cons 0 "TEXT")
         (cons 10 (trans ins 1 0))
         (cons 40
         (if (= (getvar 'tilemode) 1)
            (* (getvar 'dimscale) hgt)
            hgt
         )
         )
         (cons 1 txt)
        )
    )
  )
  (setvar "cmdecho" 0)
  (if (not prefixc)
    (setq prefixc "")
  )
  (if (not start)
    (setq start 01)
  )
  (setq
    prefixc (getstring (strcat "\nPrefix <"
                prefixc
                ">: "
             )
       )
  )
  (setq
    startc (getint (strcat "\nStarting number <"
            (strcat prefixc (itoa start))
            ">: "
         )
      )
  )
  (setq pt (getpoint "\nFirst Point: "))
  (if startc
    (setq start startc)
  )
  (while pt
    (rjp-addtext pt 0.125 (strcat prefixc (itoa start)))
    (setq start (1+ start))
    (setq
      pt (getpoint
      (strcat "\nNext point " (strcat prefixc (itoa start)) ": ")
   )
    )
  )               ;while
  (princ)
)

Thanks guys for the input. That is great

[Keith™]

Ok, another revision, but I did not address the textheight issue

Code: [Select]

(defun C:ADD (/ MINLEN STARTC PT)
  (setvar "cmdecho" 0)
  (prompt "\nUse text style with height zero to run this program")
;;; set the starting number as a string
  (if (not START)
    (setq START "01")
  );if
;;; initialize the counter - this is very important for our custom input loop below
  (setq STARTC "")
;;; custom input loop ... grab a string value ... and convert it to a number
  (while (= (numberp (distof STARTC)) NIL)
    (setq STARTC (getstring (strcat "\nStarting number <" START ">: ")))
    (if (= STARTC "")
      (setq STARTC START)
    );if
;;; get the length of the string
    (setq MINLEN (strlen STARTC))
  );while
  (setq PT (getpoint "\nFirst Point: "))
  (while PT
    (command ".text" "M" PT "" "" STARTC)
    (setq STARTC (itoa (1+ (atoi STARTC))))
;;; prepend zeros until the length is the same
    (while (< (strlen STARTC) MINLEN)
      (setq STARTC (strcat "0" STARTC))
    );while
    (setq PT (getpoint (strcat "\nNext point " STARTC ": ")))
  );while
  (princ)
);defun


[Andrea]

Code: [Select]

  (defun C:ADD (/ startc pt)
   (setvar "cmdecho" 0)
   (prompt "\nUse text style with height zero to run this program")
   (if (not start)(setq start "01"))
   (setq startc (getstring (strcat "\nStarting number <" start ">: "))
             pt (getpoint "\nFirst Point: "))
   (if startc (setq start startc))
   (if (eq start "0")(setq start "00"))
       (while pt
           (command "._text" "_M" pt "" "" start)
(if (eq (substr start 1 1) "0")    
   (setq start (strcat "0" (rtos (1+ (read start)))))
           (setq start (rtos (1+ (read start))))
   )
           (setq pt (getpoint (strcat "\nNext point " start": ")))
       );while
   (princ)
)

[CAB]

This is a variant of Keith's routine.

Code: [Select]

(defun c:add (/ minlen startc pt txtht)
  (setvar "cmdecho" 0)
  (or start (setq start "01"))
  (setq startc "")
  (while (not (numberp (distof startc)))
    (setq startc (getstring (strcat "\nStarting number <" start ">: ")))
    (and (= startc "") (setq startc start))
  )
  (setq minlen (strlen startc))
  (setq txtht (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
  (while
    (setq pt (getpoint
               (if pt
                 (strcat "\nNext point " startc ": ")
                 "\nFirst Point: ")))
     (if (zerop txtht)
       (command ".text" "M" pt "" "" startc)
       (command ".text" "M" pt "" startc)
     )
     (setq startc (itoa (1+ (atoi startc))))
     (while (< (strlen startc) minlen) ; prepend zeros
       (setq startc (strcat "0" startc))
     )
  )
  (setq start startc)
  (princ)
)

[V-Man]

This is a routine that will insert an attributed block into a space, then asks the user the bldg and floor number then asks the user to select the lwpolyline
for this space (to get the area) then ask what spid number to start with and then update the attributed block with all of the information, then
continue to the next space repeating until user cancels or finish's.

I want this to ask the user only 1 time within a session for the building/floor number so that it is nor repeated each time.
This is suppose to automatically select the last block inserted to update the information. Right now it does not.
Also, the Autoupdate of the attributers to the block is not working correctly as well.
I also want this routine to keep repeating until the user cancels for finishes.

Can you guys test this out and fill me in on how to accomplish this?

Code: [Select]

(defun c:AreaTag ( / )
(command "style" "standard" "simplex.shx" "6" "" "" "" "" "")
(do-work1)
(mkspid-lyr)
(get-spid)
(UpdateAtts)
(command ".layer" "s" "0" "")
)
(defun do-work1 ()
(vl-load-com)
(mkblk-lyr)
(setq BldgNum (strcase (getstring T"\nType in Building Number  \n"  )))
(setq FloorNum (getstring T"\nType in Floor Number  \n"  ))
  (setq grablock (ssadd))
  (setq curPoint (getpoint "\npick label insertion point: "))
  (command "-insert" "space" curpoint "" "" "")
  (ssadd (entlast) grablock)
(while
     (setq curEnt (car (entsel "\nPlease select polyline: ")))
     (setq curObj (vlax-ename->vla-object curEnt)
             curArea  (vla-get-area curObj))
;  (alert "Requires selection of Polyline!")
)
  (setq rar (strcat (rtos (/ (vla-get-area curObj) 144) 2 2 ) " Sq. Ft. "))
;(do-work1)
)
(defun get-spid () ;(/ minlen startc pt txtht)
  (setvar "cmdecho" 0)
  (or start (setq start "01"))
  (setq startc "")
  (while (not (numberp (distof startc)))
    (setq startc (getstring (strcat "\nStarting number <" start ">: ")))
    (and (= startc "") (setq startc start))
  )
  (setq minlen (strlen startc))
(setq pt curPoint)
       (command ".text" "M" pt "" startc)
     (setq startc (itoa (1+ (atoi startc))))
     (while (< (strlen startc) minlen) ; prepend zeros
       (setq startc (strcat "0" startc))
     )
  (setq start startc)
  (princ)
)
(defun mkblk-lyr ()
   (setq lay1 (tblsearch "layer" "A-AREA-IDEN"))
(if (= lay1 nil)
(entmake (list
                              '(0 . "LAYER")
                              '(100 . "AcDbSymbolTableRecord")
                              '(100 . "AcDbLayerTableRecord")
      '(2 . "A-AREA-IDEN")
                              '(6 . "CONTINUOUS")
                              '(62 . 7)
                              '(70 . 0)
                             )
      );end entmake
);end if
(command ".layer" "s" "A-AREA-IDEN" "")
)
(defun mkspid-lyr ()
   (setq lay2 (tblsearch "layer" "3"))
(if (= lay2 nil)
(entmake (list
                              '(0 . "LAYER")
                              '(100 . "AcDbSymbolTableRecord")
                              '(100 . "AcDbLayerTableRecord")
      '(2 . "3")
                              '(6 . "CONTINUOUS")
                              '(62 . 7)
                              '(70 . 0)
                             )
      );end entmake
);end if
(command ".layer" "s" "3" "")
)
(defun UpdateAtts ()
  (cond ((setq sset (ssget '((2 . "SPACE") (66 . 1))))
         (setq a 0)
         (repeat (sslength sset)
           (setq ent (ssname sset a)
                 a   (1+ a)
           )
           (changeAtt ent "AREA" rar) ;<- Area SF
           (changeAtt ent "SPID" startc) ;<- Spid #
           (changeAtt ent "BLDGID" BldgNum) ;<- Bldg #
           (changeAtt ent "FLRID" FloorNum) ;<- Floor #
         )
        )
  )
  (princ)
)
(defun changeAtt (ent tag val / entl ins)
  (setq ins ent)
  (while (and ent
           (/= "SEQEND" (cdr (assoc 0 (setq entl (entget ent))))))
    (if (and (= (cdr (assoc 0 entl)) "ATTRIB")
             (= (cdr (assoc 2 entl)) tag))
      (entmod (subst (cons 1 val) (assoc 1 entl) entl)))
    (setq ent (entnext ent)))
  (entupd ins)
)