See the top rated post in this thread. Click here

Page 1 of 3 123 LastLast
Results 1 to 10 of 28

Thread: Copying a number and increase the value at the same time

  1. #1
    I could stop if I wanted to lmitsou's Avatar
    Join Date
    2003-01
    Location
    UK
    Posts
    219
    Login to Give a bone
    0

    Default Copying a number and increase the value at the same time

    Hi all,

    I was wondering if there is any way to copy a number (written in AutoCAD using Mtext) and when you duplicate it, it's value will increase by a certain number added to it (number to be defined by the user). So for example, if you write in text editor "1" and then you copy it, it will be copied as 1+ number defined by user. Is there any way of doing this or any routine that can achieve this?

    Thank you all in advance.

  2. #2
    100 Club
    Join Date
    2003-11
    Location
    Dublin, Ireland.
    Posts
    152
    Login to Give a bone
    1

    Default Re: Copying a number and increase the value at the same time

    Try this :

    Code:
    (defun c:copyinc (/ IncVal TextObj NewPos TextVal NewTextObj)
    (vl-load-com)
      (setq IncVal (fix (getreal "\nEnter Incremant Value :")))
      (setq	TextObj
    	 (vlax-ename->vla-object (car (entsel "\nSelect Mtext Object :")))
      )
      (while
        (setq NewPos (getpoint "\nSelect new position : "))
         (setq TextVal (atoi (vla-get-textstring TextObj)))
         (setq NewTextObj (vla-copy TextObj))
         (vla-move NewTextObj
    	       (vla-get-InsertionPoint NewTextObj)
    	       (vlax-3D-Point NewPos)
         )
         (vla-put-textstring NewTextObj (+ IncVal TextVal))
         (setq TextObj NewTextObj)
      )
      (princ)
    )
    Last edited by jmcshane; 2008-07-02 at 05:07 PM. Reason: Forgot CODE tags

  3. #3
    I could stop if I wanted to
    Join Date
    2007-08
    Posts
    202
    Login to Give a bone
    1

    Default Re: Copying a number and increase the value at the same time

    Hi

    Here's a 'quickie'

    Code:
    (defun c:inc-copy (/ inc txt elst pt val)
      (if (setq inc (getint "\nIncrement value: "))
        (if	(and
    	  (setq txt (car (entsel "\nSelect a text or mtext: ")))
    	  (member (cdr (assoc 0 (setq elst (entget txt))))
    		  '("MTEXT" "TEXT")
    	  )
    	  (= 'INT (type (setq val (read (cdr (assoc 1 elst))))))
    	)
          (while (setq pt (getpoint "\nInsertion point: "))
    	(setq val (+ val inc))
    	(entmake
    	  (subst (cons 10 pt) (assoc 10 elst)
    	    (subst (cons 11 pt) (assoc 11 elst)
    			 (subst (cons 1 (itoa val)) (assoc 1 elst) elst)
    		   )
    	    )
    	  )
    	)
          (princ "\nInvalid entity")
        )
      )
      (princ)
    )

  4. #4
    100 Club
    Join Date
    2003-11
    Location
    Dublin, Ireland.
    Posts
    152
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Quote Originally Posted by 'gile' View Post
    (and
    (setq txt (car (entsel "\nSelect a text or mtext: ")))
    (member (cdr (assoc 0 (setq elst (entget txt))))
    '("MTEXT" "TEXT")
    )
    (= 'INT (type (setq val (read (cdr (assoc 1 elst))))))
    )
    Every day is a learning day here at AUGI.
    Nice one 'gile'. thats the first time I have seen both "type" and "read" used in AutoLisp.

    Thanks

  5. #5
    I could stop if I wanted to CadDog's Avatar
    Join Date
    2005-06
    Location
    So Ca
    Posts
    439
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Can we do this with a block with Text Attributes...???

    Here is a old lisp I have which I call Edit Any (text). Dtext, Mtext, dims, Text Attributes...

    Is there away to add

    ((= etype "ATTDEF")
    (strcat "Default " (cdr (assoc 3 elist)))
    )
    ((= etype "ATTRIB")
    (strcat "Attribute with Tag: " (cdr (assoc 2 elist)))


    and have this increment those other types of text also...???

    Thanks


    Code:
    ;|
    This routine will edit the following text type entities:
    Text
    Attributes
    Attribute definitions
    Dimension Text
    
    |;
    
    
    (defun catcherr (s)
         (if (/= s "Function cancelled")   ; If an error (such as CTRL-C) occurs
              (princ (strcat "\nError: " s)) ; while this command is active...
         )
         (setq p nil)                      ; Free selection set
         (setq *error* olderr)             ; Restore old *error* handler
         (princ)
    )
    
    
    (defun c:txe(;			edit text type entities
         /;				no formal arguments
         ent;				entity info returned by nentsel
         elist;			entity list
         etype;			entity type
         etype2;			entity type for dialog box label
         oldval;			original text value
         newval;			new text value
         elist2;			new entity list
         get_newval;			local function
    );				end local variable list
    ;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Start local functions ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
    (setq olderr *error*
    *error* catcherr)
    
    
    (defun get_newval(
         oldval;			old value to be changed
         etype;			entity type for dialog box label
         /;				end of formal argument list
    );				end of local variable list
    (setq dcl_id (load_dialog "txe.dcl"))
    (if (not (new_dialog "text_edit" dcl_id)) (exit))
    (set_tile "text" oldval)
    (if etype
         (set_tile "box" etype)
    )
    (action_tile "text" "(setq newval $value)" )
    (action_tile "accept" "(done_dialog 1)" )
    (if (equal (start_dialog) 1)
         nil
         (setq newval nil)
    )
    (unload_dialog dcl_id)
    newval
    );				end get_newval
    
    
    ;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ Start Main Function ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
    (while (setq ent (nentsel))
    (setq
         ent2 ent
         elist (entget (car ent))
         etype (cdr (assoc 0 elist))
    );				end setq
    (if (member etype '("TEXT" "ATTDEF" "ATTRIB" "MTEXT"))
         (progn
              (setq
                   etype2 (cond
                        ((= etype "ATTDEF")
                             (strcat "Default " (cdr (assoc 3 elist)))
                        )
                        ((= etype "ATTRIB")
                             (strcat "Attribute with Tag: " (cdr (assoc 2 elist)))
                        )
                        ((= etype "TEXT")
                             (if (= 4 (length ent))
                                  (progn
                                       (setq
                                            diment (car (last ent))
                                            dimlist (entget diment)
                                       );			end setq
                                       (if (= "DIMENSION" (cdr (assoc 0 dimlist)))
                                            "Dimension Text"
                                            "Nested text"
                                       );			end if dimension?
                                  );			end progn nested entity
                             );			end progn nested entity
                        );			end cond text
                   );				end cond etype
                   oldval (cdr (assoc 1 elist))
                   newval (get_newval oldval etype2)
                   elist2 (if newval
                        (subst (cons 1 newval) (assoc 1 elist) elist)
                        nil
                   );				end if newval returned
              );				end setq
              (if elist2
                   (progn
                        (entmod elist2)
                        (if (= 4 (length ent))
                             (progn
                                  (setq
                                       diment (car (last ent))
                                       dimlist (entget diment)
                                  );			end setq
                                  (if (= "DIMENSION" (cdr (assoc 0 dimlist)))
                                       (progn
                                            (setq dimlist2 (subst (cons 1 newval) (assoc 1 dimlist) dimlist))
                                            (entmod dimlist2)
                                            (entupd diment)
                                       );			end progn
                                  );			end if dimension
                                  (if (= "INSERT" (cdr (assoc 0 dimlist)))
                                       (entupd diment)
                                  );			end if insert
                                  ;       (setq cmdecho (getvar "cmdecho"))
                                  ;       (command "dim" "update" diment "" "e")
                             );			end progn ent is nested
                             (entupd (cdr (assoc -1 elist)))
                        );			end if ent is nested?
                   );				end progn elist2 exists
              );				end if elist2 exists?
         );				end progn correct type of entity
         (princ "\nNot a text, attdef or attribute entity. ")
    );				end if
    );				end while
    (princ)
    );				end c:txe
    
    (princ "\nC:TXE To Edit Any Text\n")
    (princ)

  6. #6
    I could stop if I wanted to CadDog's Avatar
    Join Date
    2005-06
    Location
    So Ca
    Posts
    439
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Here is what I found and where you can see what I did...

    Thanks guys and have a great and save 4th...

    http://forums.augi.com/showthread.ph...624#post862624

  7. #7
    I could stop if I wanted to lmitsou's Avatar
    Join Date
    2003-01
    Location
    UK
    Posts
    219
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Great stuff from everybody guys. Thanks for the fast reply.


  8. #8
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,125
    Login to Give a bone
    1

    Default Re: Copying a number and increase the value at the same time

    Here is a routine that use two command reactors.
    I made it recognize MTEXT or TEXT on a special layer "INCREMENT" and if they are copied using the COPY command it will increment the INTEGER value of the textstring property.

    It can be loaded using the acaddoc.lsp lisp at the opening of the drawing.

    Peter

    Code:
    
    (defun CommandEndedSub (evtCall lstCallback)
     (if (= (car lstCallback) "COPY")
      (while (setq entLastItem (entnext entLastItem))
       (setq objLastItem (vlax-ename->vla-object entLastItem))
       (if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
                 (= (strcase (vla-get-layer objLastItem)) "INCREMENT")   
                 
            )
        (vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring objLastItem)))))    
       )
      )
     )
     (setq entLastItem nil)
    )
    
    (defun CommandWillStartSub (evtCall lstCallBack)
     (if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
    )
    
    (setq rxnCommandWillStart (vlr-editor-reactor nil '((:vlr-commandwillstart . CommandWillStartSub)))
          rxnCommandEnded     (vlr-editor-reactor nil '((:vlr-commandended     . CommandEndedSub)))
    )
    (vl-load-com)
    
    

  9. #9
    I could stop if I wanted to lmitsou's Avatar
    Join Date
    2003-01
    Location
    UK
    Posts
    219
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Great routine. Thanks!

  10. #10
    I could stop if I wanted to CadDog's Avatar
    Join Date
    2005-06
    Location
    So Ca
    Posts
    439
    Login to Give a bone
    0

    Default Re: Copying a number and increase the value at the same time

    Quote Originally Posted by peter View Post
    Here is a routine that use two command reactors.
    I made it recognize MTEXT or TEXT on a special layer "INCREMENT" and if they are copied using the COPY command it will increment the INTEGER value of the textstring property.

    It can be loaded using the acaddoc.lsp lisp at the opening of the drawing.

    Peter

    Code:
    
    (defun CommandEndedSub (evtCall lstCallback)
     (if (= (car lstCallback) "COPY")
      (while (setq entLastItem (entnext entLastItem))
       (setq objLastItem (vlax-ename->vla-object entLastItem))
       (if (and (wcmatch (vla-get-objectname objLastItem) "AcDb*Text")
                 (= (strcase (vla-get-layer objLastItem)) "INCREMENT")   
                 
            )
        (vla-put-textstring objLastItem (itoa (1+ (atoi (vla-get-textstring objLastItem)))))    
       )
      )
     )
     (setq entLastItem nil)
    )
    
    (defun CommandWillStartSub (evtCall lstCallBack)
     (if (= (car lstCALLBACK) "COPY")(setq entLastItem (entlast)))
    )
    
    (setq rxnCommandWillStart (vlr-editor-reactor nil '((:vlr-commandwillstart . CommandWillStartSub)))
          rxnCommandEnded     (vlr-editor-reactor nil '((:vlr-commandended     . CommandEndedSub)))
    )
    (vl-load-com)
    
    
    I wasn't able to get this one to work...
    I loaded it using vlide and lisp load...
    I created the layer and add dtext and used copy but nothing happen...

Page 1 of 3 123 LastLast

Similar Threads

  1. Replies: 4
    Last Post: 2016-06-25, 06:19 PM
  2. Increase the number of active view ports available
    By Wish List System in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2012-07-19, 07:48 PM
  3. Copying Objects takes avery long time!
    By kendallmonk in forum AutoCAD General
    Replies: 5
    Last Post: 2009-05-25, 02:01 PM
  4. Replies: 4
    Last Post: 2009-03-05, 10:30 PM
  5. Do fields greatly increase the save time?
    By jkipfer in forum AutoCAD Fields
    Replies: 11
    Last Post: 2005-03-11, 02:02 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •