Jump to content

mattCAD

Recommended Posts

I have a number of drawings with levels on (single line and multitext) which are currently set to a local datum and I need to amend all to ordnance datum. To help reduce the time involved to do this I am looking for lisp routine that can find levels which are to 3 decimal places and add a set figure to it. (ie add 0.57m to every level on the drawing.

 

Thanks for your help in advance

Link to comment
Share on other sites

If I understand your question, for similar situations, I use this routine. Unknown to the author.

 

(defun chgterr (s)
  (if (/= s "Function cancelled")   
     (princ (strcat "\nError: " s)) 
  )
  (setq p nil)                      
  (setq *error* olderr)             
  (princ)
)

(defun C:INC (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
  (setq olderr  *error*             
        *error* chgterr
        chm     0)
  (setq p (ssget))                  
  (setq inc (getreal "\nIncrement:"))
     (setq l 0 n (sslength p))
     (while (< l n)                 
        (if (= "TEXT"               
               (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (progn
               (setq s (cdr (setq as (assoc 1 e))))
               (setq mn (atof s))
               (setq nm (+ mn inc))
               (setq s (rtos nm))
               (setq e (subst (cons 1 s) as e))
               (entmod e)         
               (setq chm (1+ chm))
              )
        )
        (setq l (1+ l))
     )
  (princ chm)
  (princ " text lines")
  (princ " changed.")
  (terpri)
  (setq *error* olderr)             
  (princ)
)

Link to comment
Share on other sites

If I understand your question, for similar situations, I use this routine. Unknown to the author.

 

(defun chgterr (s)
  (if (/= s "Function cancelled")   
     (princ (strcat "\nError: " s)) 
  )
  (setq p nil)                      
  (setq *error* olderr)             
  (princ)
)

(defun C:INC (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
  (setq olderr  *error*             
        *error* chgterr
        chm     0)
  (setq p (ssget))                  
  (setq inc (getreal "\nIncrement:"))
     (setq l 0 n (sslength p))
     (while (< l n)                 
        (if (= "TEXT"               
               (cdr (assoc 0 (setq e (entget (ssname p l))))))
              (progn
               (setq s (cdr (setq as (assoc 1 e))))
               (setq mn (atof s))
               (setq nm (+ mn inc))
               (setq s (rtos nm))
               (setq e (subst (cons 1 s) as e))
               (entmod e)         
               (setq chm (1+ chm))
              )
        )
        (setq l (1+ l))
     )
  (princ chm)
  (princ " text lines")
  (princ " changed.")
  (terpri)
  (setq *error* olderr)             
  (princ)
)

 

This is a bit simpler, and supports 'undo' functionality:

(vl-load-com)

(defun c:FOO (/ *error* ss i acDoc)

 (defun *error* (msg)
   (if acDoc
     (vla-endundomark acDoc)
   )
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )

 (if (and (setq ss (ssget '((0 . "MTEXT,TEXT") (1 . "*#.#*"))))
          (setq i (getreal "\nEnter increment: "))
     )
   (progn
     (vla-startundomark
       (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
     )
     (vlax-for x (vla-get-activeselectionset acDoc)
       (vla-put-textstring
         x
         (rtos (+ i (atof (vla-get-textstring x))) 2 3)
       )
     )
     (prompt (strcat "\n** " (itoa (sslength ss)) " object(s) modified ** ")
     )
   )
 )
 (*error* nil)
)

Link to comment
Share on other sites

Perfect that was exactly what I was looking for, Thanks for your help:)

 

For TEXT and MTEXT:

 

 

 

(defun chgterr (s)
  (if (/= s "Function cancelled")   
     (princ (strcat "\nError: " s)) 
  )
  (setq p nil)                      
  (setq *error* olderr)             
  (princ)
)

(defun C:INC (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
  (setq olderr  *error*             
        *error* chgterr
        chm     0)
  (setq p (ssget '((0 . "TEXT,MTEXT"))))                 
  (setq inc (getreal "\nIncrement:"))
     (setq l 0 n (sslength p))
     (while (< l n)                 
            
               (cdr (assoc 0 (setq e (entget (ssname p l)))))
              (progn
               (setq s (cdr (setq as (assoc 1 e))))
               (setq mn (atof s))
               (setq nm (+ mn inc))
               (setq s (rtos nm))
               (setq e (subst (cons 1 s) as e))
               (entmod e)         
               (setq chm (1+ chm))
              );progn
	(setq l (1+ l))
      ); while
   
  (princ chm)
  (princ " text lines")
  (princ " changed.")
  (terpri)
  (setq *error* olderr)             
  (princ)
  );defun

Link to comment
Share on other sites

For TEXT and MTEXT:

 

 

 

(defun chgterr (s)
  (if (/= s "Function cancelled")   
     (princ (strcat "\nError: " s)) 
  )
  (setq p nil)                      
  (setq *error* olderr)             
  (princ)
)

(defun C:INC (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
  (setq olderr  *error*             
        *error* chgterr
        chm     0)
  (setq p (ssget '((0 . "TEXT,MTEXT"))))                 
  (setq inc (getreal "\nIncrement:"))
     (setq l 0 n (sslength p))
     (while (< l n)                 
            
               (cdr (assoc 0 (setq e (entget (ssname p l)))))
              (progn
               (setq s (cdr (setq as (assoc 1 e))))
               (setq mn (atof s))
               (setq nm (+ mn inc))
               (setq s (rtos nm))
               (setq e (subst (cons 1 s) as e))
               (entmod e)         
               (setq chm (1+ chm))
              );progn
	(setq l (1+ l))
      ); while
   
  (princ chm)
  (princ " text lines")
  (princ " changed.")
  (terpri)
  (setq *error* olderr)             
  (princ)
  );defun

 

I sure hope the user always selects a valid selections set... Example: consider a TextString = "Bowties are cool".

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...