IS there any routine to put all the text in the auto cad on grid

Hi,

let me thank you all for your help in previous postings..........now I came with another issue an auto cad drawings with lot of texts have been provided by client and he is asking to put all the text on grid and snap (grid1 and snap1) ...which was not placed on grid and snap earlier. If any one have routine to put all text on grid at a time please provide me.

(defun C:FIXTEXT ( / *error* acDoc round ss d)
 
 (defun round (n) (* d (fix (+ 0.5 (/ (abs n) d))) (if (minusp n) -1 1)))
 
 (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*EXIT*,*QUIT*,*CANCEL*"))
     (princ (strcat "\nError: " msg))
     )
   (vla-endundomark acDoc)
   (princ)
   )
 
 (if
   (and
     (setq ss (ssget ":L" '((0 . "TEXT"))))
     (progn
       (initget 6)
       (setq d (getdist "\nSnap value: "))
     )
   )
   (repeat (setq i (sslength ss))
     (entmod
       (mapcar
         (function
           (lambda (x)
             (if
               (<= 10 (car x) 11)
               (cons (car x) (mapcar 'round (cdr x)))
               x
             )
           )
         )
         (entget (ssname ss (setq i (1- i))))
       )
     )
   )
 )
 (vla-endundomark acDoc)
 (princ)
)

Stefan BMR - I loaded this in my drawing and got an error message, error: syntax error.

Any ideas on how to fix it?

Thanks,

rkent

Stefan BMR - I loaded this in my drawing and got an error message, error: syntax error.

 

Any ideas on how to fix it?

 

Thanks,

rkent

I could not reproduce the error. Started a fresh new ACAD session an copied the code from my post. It works OK.

I had changed the name to FIXTEXT TO SNAP, so when I put it back to what you provided it works fine. Can this include MTEXT as well as TEXT?

Thanks.

This routine moves selected objects to be on grid

(defun c:round ( / e i k l m s ) ;LEE MAC
   (setq l
      '(
           ("CIRCLE"     10 40)
           ("LINE"       10 11)
           ("LWPOLYLINE" 10)
           ("INSERT"     10)
           ("POINT"      10)
       )
   )            
   (if (null *tol*)
       (setq *tol* 5.0)
   )
   (initget 6)
   (if (setq m (getreal (strcat "\nSpecify rounding tolerance <" (rtos *tol*) ">: ")))
       (setq *tol* m)
       (setq m *tol*)
   )
   (if (setq s (ssget "_:L" '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT"))))
       (repeat (setq i (sslength s))
           (if (setq e (entget (ssname s (setq i (1- i))))
                     k (cdr (assoc (cdr (assoc 0 e)) l))
               )
               (entmod (rounddxf k m e))
           )
       )
   )
   (princ)
)

(defun rounddxf ( key mod lst / rtn )
   (foreach itm lst
       (if (member (car itm) key)
           (setq rtn (cons (cons (car itm) (roundvalue (cdr itm) mod)) rtn))
           (setq rtn (cons itm rtn))
       )
   )
   (reverse rtn)
)

(defun roundvalue ( val mod )
   (if (listp val)
       (mapcar '(lambda ( x ) (round x mod)) val)
       (round val mod)
   )
)

;; Doug Broad
(defun round ( value to )
   (setq to (abs to))
   (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))
)
(princ)

... Can this include MTEXT as well as TEXT?

Of course kent. Change (0 . "TEXT") to (0 . "*TEXT") or (0 . "TEXT,MTEXT").

This routine moves selected objects to be on grid

Thank you for the recommendation Hasan -

The program can be used with Text & MText by adding the following lines to the list at the top of the code:

(defun c:round ( / e i k l m s ) ; LEE MAC
   (setq l
      '(
           ("CIRCLE"     10 40)
           ("LINE"       10 11)
           ("LWPOLYLINE" 10)
           ("INSERT"     10)
           ("POINT"      10)
[color=red]            ("MTEXT"      10)
           ("TEXT"       10 11)[/color]
       )
   )
   ...
)

Thank you for the recommendation Hasan -

It is my pleasure Lee

Thank you stefan BMR, RKENT, LEE MAC, ASOS 2000.

for your effort and help,you all my made my work easy.......thanks........

Thank you for resolving how to move text on grid...while doing this I got thought is this routine can be changed to move blocks along with attribute text. ASOS 2000, round routine is only moving blocks but not text. Obviously he made routine to move only objects not blocks...

I think is there a missing in ssget syntax.

(if (setq s (ssget "_:L" '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT,[color=red]MTEXT,[/color][color=red]TEXT[/color]"))))

I think is there a missing in ssget syntax.

 

(if (setq s (ssget "_:L" '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT,[color=red]MTEXT,[/color][color=red]TEXT[/color]"))))

Yes, this is also required - thank you.