Geometry analysis for text and blocks using AutoCAD

Hi Everyone,

I have a rather interesting problem that I wanted to get some advice on. What I want to do is be able to turn Autocad TEXT & BLOCKS into geometries that I can then do analysis on.

My goal is to be able to say "This piece of text sits on top of that block, please seperate them manually" to an end user.

My current idea is explode a block, inspect its elements and generate a rectangle from bottom left to top right, then work out text using the system below (if I have to) then compare all blocks and text objects to all other blocks and text objects in the drawing.

My text solution currently looks like

1. Catalog the height and widths of all used fonts in lower and uppercase (of which I have about 50) manually
   
2. Use that as a lookup to determine the size of any given string in any given font at any given size
   
3. Build a rectangle based on those results

Finally do a crossing based on these rectangles to determine if they fall on any others and if they do, to report it somehow.

Any suggestions on a) avoiding the above system for fonts or b) accessing this information more easily or less staticly would be appreciated.

Cheers.

I don't quite understand your intentions, but text is annoying to deal with, so it would probably be easier to convert it to basic objects from which you can do your calculations.

 

 

Perhaps look at using TXTEXP or see

here.

 

Lee

Hi Lee, thanks for the quick response. I've never heard of TXTEXP and seems to be a start in the right direction. The concern I have with it is then trying to work out what objects it exploded - still just knowing about that routine has probably saved me weeks of wasting time.

Basically what I want is to find where blocks and text overlap, encouraging the user to move them apart.

If I understand your problem Ewan, would this help?

(defun c:txtlap (/ *error* RotateByMatrix AddLwPoly BBox->List GroupByNum GetTextIns Point

                  BBOX DOC ILST LAYER LL NOBJ POLY PT R SPC SS UFLAG UR)
 
 ;; Lee Mac  ~  15.03.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (setq layer "TxtLapCheck")

 (defun RotateByMatrix (obj pt ang / RotationMatrix Vector)
   ;; Rotation by Matrix  ~  Lee Mac 

   (setq RotationMatrix (list (list (cos ang) (- (sin ang))  0.0)
                              (list (sin ang)    (cos ang)   0.0)
                              (list    0.0           0.0     1.0)))

   (setq Vector (mapcar (function -) pt
                        (mapcar
                          (function
                            (lambda (row) (apply (function +)
                                                 (mapcar (function *) row pt))))
                          RotationMatrix))) 
   (vla-transformby obj
     (vlax-tmatrix
       (append
         (mapcar
           (function
             (lambda (r x) (append r (list x))))

           RotationMatrix Vector)

         '((0.0 0.0 0.0 1.0))))))
 

 (defun AddLWPoly (blk lst)
   (vla-AddLightWeightPolyline blk
     (vlax-make-variant
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble
           (cons 0 (1- (* 2 (length lst)))))
         (apply (function append) lst)))))
 

 (defun BBox->List (ll ur)
   (list (list (car ll) (cadr ll))
         (list (car ll) (cadr ur))
         (list (car ur) (cadr ur))
         (list (car ur) (cadr ll))))
 

 (defun GroupByNum (lst num / rtn)
   (setq rtn nil)
   
   (if lst
     (cons (reverse
             (repeat num
               (progn
                 (setq rtn (cons (car lst) rtn)
                       lst (cdr lst))
                 rtn)))
           
           (GroupByNum lst num))))
 

 (defun GetTextIns (object)
   (vlax-get object
     (if (eq "AcDbText" (vla-get-ObjectName object))
       (if (eq acAlignmentLeft (vla-get-Alignment object))
         'InsertionPoint 'TextAlignmentPoint)
       'InsertionPoint)))
 

 (defun Point (pt)
   (entmakex (list (cons 0 "POINT")
                   (cons 8 layer)
                   (cons 10 pt)                    
                   (cons 62 2))))
 

 (defun SS->VLA (ss / i e lst)
   (setq i -1)
   (while (setq e (ssname ss (setq i (1+ i))))
     (setq lst (cons (vlax-ename->vla-object e) lst)))
   
   lst)  
 

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

       spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                   (eq :vlax-true   (vla-get-MSpace doc)))
             (vla-get-ModelSpace doc)
             (vla-get-PaperSpace doc)))  

 (or (tblsearch "LAYER" layer)
     (vla-add (vla-get-layers doc) layer))
 
 (if (ssget '((0 . "TEXT,MTEXT")))
   (progn
     (setq uFlag (not (vla-StartUndoMark doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (if (not (zerop (setq r (vla-get-Rotation obj))))
         (progn
           (vla-put-rotation (setq nobj (vla-copy obj)) 0.0)
           (vla-getBoundingBox nobj 'll 'ur)

           (RotateByMatrix              
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))

             (GetTextIns obj) r)
           
           (vla-put-layer Poly layer)
           (vla-put-Closed Poly :vlax-true)
           (vla-delete nobj))

         (progn
           (vla-getBoundingBox obj 'll 'ur)
           (vla-put-layer
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))
             layer)
           
           (vla-put-Closed Poly :vlax-true)))

       (if (setq iLst
                  (apply (function append)
                    (vl-remove-if (function null)
                      (mapcar
                        (function
                          (lambda (object)
                            (GroupByNum
                              (vlax-invoke Poly
                                'IntersectWith object acExtendNone) 3)))
                        
                        (vl-remove obj
                          (ss->VLA
                            (ssget "_C" (trans (caddr bBox) 1 0)
                                        (trans (car bBox)   1 0)

                                   '((0 . "~VIEWPORT")))))))))
         
         (progn
           (vla-put-color Poly acRed)
           (mapcar (function Point) iLst))

         (vla-put-color Poly acGreen)))

     (vla-delete ss)
     (setq uFlag (vla-EndUndoMark doc))))

 (princ))

If I understand your problem Ewan, would this help?

 

If the code does what the GIF implies it looks perfect. I'll have a proper look tomorrow at my desk, i suspect the only element I need now is to make the same thing happen for blocks.

Thanks for your assistance, I'll let you know how it goes.

Very nice Lee...

But did you know of the Tspaceinvaders command?

Very nice Lee...

 

But did you know of the Tspaceinvaders command?

No I didn't - looks pretty much like what I have done - nice one Larry

If the code does what the GIF implies it looks perfect. I'll have a proper look tomorrow at my desk, i suspect the only element I need now is to make the same thing happen for blocks.

 

Thanks for your assistance, I'll let you know how it goes.

Actually, as block have a rotation property - this should work for them also:

(defun c:overlap (/ *error* RotateByMatrix AddLwPoly BBox->List GroupByNum GetTextIns Point

                  BBOX DOC ILST LAYER LL NOBJ POLY PT R SPC SS UFLAG UR)
 
 ;; Lee Mac  ~  15.03.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (setq layer "TxtLapCheck")

 (defun RotateByMatrix (obj pt ang / RotationMatrix Vector)
   ;; Rotation by Matrix  ~  Lee Mac 

   (setq RotationMatrix (list (list (cos ang) (- (sin ang))  0.0)
                              (list (sin ang)    (cos ang)   0.0)
                              (list    0.0           0.0     1.0)))

   (setq Vector (mapcar (function -) pt
                        (mapcar
                          (function
                            (lambda (row) (apply (function +)
                                                 (mapcar (function *) row pt))))
                          RotationMatrix))) 
   (vla-transformby obj
     (vlax-tmatrix
       (append
         (mapcar
           (function
             (lambda (r x) (append r (list x))))

           RotationMatrix Vector)

         '((0.0 0.0 0.0 1.0))))))
 

 (defun AddLWPoly (blk lst)
   (vla-AddLightWeightPolyline blk
     (vlax-make-variant
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble
           (cons 0 (1- (* 2 (length lst)))))
         (apply (function append) lst)))))
 

 (defun BBox->List (ll ur)
   (list (list (car ll) (cadr ll))
         (list (car ll) (cadr ur))
         (list (car ur) (cadr ur))
         (list (car ur) (cadr ll))))
 

 (defun GroupByNum (lst num / rtn)
   (setq rtn nil)
   
   (if lst
     (cons (reverse
             (repeat num
               (progn
                 (setq rtn (cons (car lst) rtn)
                       lst (cdr lst))
                 rtn)))
           
           (GroupByNum lst num))))
 

 (defun GetTextIns (object)
   (vlax-get object
     (if (eq "AcDbText" (vla-get-ObjectName object))
       (if (eq acAlignmentLeft (vla-get-Alignment object))
         'InsertionPoint 'TextAlignmentPoint)
       'InsertionPoint)))
 

 (defun Point (pt)
   (entmakex (list (cons 0 "POINT")
                   (cons 8 layer)
                   (cons 10 pt)                    
                   (cons 62 2))))
 

 (defun SS->VLA (ss / i e lst)
   (setq i -1)
   (while (setq e (ssname ss (setq i (1+ i))))
     (setq lst (cons (vlax-ename->vla-object e) lst)))
   
   lst)  
 

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

       spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                   (eq :vlax-true   (vla-get-MSpace doc)))
             (vla-get-ModelSpace doc)
             (vla-get-PaperSpace doc)))  

 (or (tblsearch "LAYER" layer)
     (vla-add (vla-get-layers doc) layer))
 
 (if (ssget '((0 . "TEXT,MTEXT,INSERT")))
   (progn
     (setq uFlag (not (vla-StartUndoMark doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (if (not (zerop (setq r (vla-get-Rotation obj))))
         (progn
           (vla-put-rotation (setq nobj (vla-copy obj)) 0.0)
           (vla-getBoundingBox nobj 'll 'ur)

           (RotateByMatrix              
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))

             (GetTextIns obj) r)
           
           (vla-put-layer Poly layer)
           (vla-put-Closed Poly :vlax-true)
           (vla-delete nobj))

         (progn
           (vla-getBoundingBox obj 'll 'ur)
           (vla-put-layer
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))
             layer)
           
           (vla-put-Closed Poly :vlax-true)))

       (if (setq iLst
                  (apply (function append)
                    (vl-remove-if (function null)
                      (mapcar
                        (function
                          (lambda (object)
                            (GroupByNum
                              (vlax-invoke Poly
                                'IntersectWith object acExtendNone) 3)))
                        
                        (vl-remove obj
                          (ss->VLA
                            (ssget "_C" (trans (caddr bBox) 1 0)
                                        (trans (car bBox)   1 0)

                                   '((0 . "~VIEWPORT")))))))))
         
         (progn
           (vla-put-color Poly acRed)
           (mapcar (function Point) iLst))

         (vla-put-color Poly acGreen)))

     (vla-delete ss)
     (setq uFlag (vla-EndUndoMark doc))))

 (princ))

Actually, as block have a rotation property - this should work for them also:

Wow, if I were able to complete my wishlist it would be to specify obects (by type and layer that were not considered when working out which objects to compare against)

e.g. remove other text, or layers beginning with "IGN" or whatever.

I've never learnt any of the VLA commands, I am pretty much self-taught from AIDACAD (which now seems to be gone) and afralisp.

Are there good sites around to learn that component of AutoLISP? Is it worth knowing if I have a pretty good understanding of regular lisp and visual lisp commands?

Thanks for all your help once again.

Hi Ewan,

If you are aware of ssget filter lists, then this will help.

I have added an option to the top of the list to specify which objects to filter out/in when comparing the text.

(defun c:overlap (/ *error* RotateByMatrix AddLwPoly BBox->List GroupByNum GetTextIns Point

                  BBOX DOC FILTLST ILST LAYER LL NOBJ POLY PT R SPC SS UFLAG UR)
 
 ;; Lee Mac  ~  15.03.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (setq layer "TxtLapCheck")

 [color=Red][b](setq FiltLst '((-4 . "<NOT") (0 . "VIEWPORT,*TEXT") (-4 . "NOT>")))[/b][/color]

 (defun RotateByMatrix (obj pt ang / RotationMatrix Vector)
   ;; Rotation by Matrix  ~  Lee Mac 

   (setq RotationMatrix (list (list (cos ang) (- (sin ang))  0.0)
                              (list (sin ang)    (cos ang)   0.0)
                              (list    0.0           0.0     1.0)))

   (setq Vector (mapcar (function -) pt
                        (mapcar
                          (function
                            (lambda (row) (apply (function +)
                                                 (mapcar (function *) row pt))))
                          RotationMatrix))) 
   (vla-transformby obj
     (vlax-tmatrix
       (append
         (mapcar
           (function
             (lambda (r x) (append r (list x))))

           RotationMatrix Vector)

         '((0.0 0.0 0.0 1.0))))))
 

 (defun AddLWPoly (blk lst)
   (vla-AddLightWeightPolyline blk
     (vlax-make-variant
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble
           (cons 0 (1- (* 2 (length lst)))))
         (apply (function append) lst)))))
 

 (defun BBox->List (ll ur)
   (list (list (car ll) (cadr ll))
         (list (car ll) (cadr ur))
         (list (car ur) (cadr ur))
         (list (car ur) (cadr ll))))
 

 (defun GroupByNum (lst num / rtn)
   (setq rtn nil)
   
   (if lst
     (cons (reverse
             (repeat num
               (progn
                 (setq rtn (cons (car lst) rtn)
                       lst (cdr lst))
                 rtn)))
           
           (GroupByNum lst num))))
 

 (defun GetTextIns (object)
   (vlax-get object
     (if (eq "AcDbText" (vla-get-ObjectName object))
       (if (eq acAlignmentLeft (vla-get-Alignment object))
         'InsertionPoint 'TextAlignmentPoint)
       'InsertionPoint)))
 

 (defun Point (pt)
   (entmakex (list (cons 0 "POINT")
                   (cons 8 layer)
                   (cons 10 pt)                    
                   (cons 62 2))))
 

 (defun SS->VLA (ss / i e lst)
   (setq i -1)
   (if ss
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq lst (cons (vlax-ename->vla-object e) lst))))
   
   lst)  
 

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

       spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                   (eq :vlax-true   (vla-get-MSpace doc)))
             (vla-get-ModelSpace doc)
             (vla-get-PaperSpace doc)))  

 (or (tblsearch "LAYER" layer)
     (vla-add (vla-get-layers doc) layer))
 
 (if (ssget '((0 . "TEXT,MTEXT,INSERT")))
   (progn
     (setq uFlag (not (vla-StartUndoMark doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (if (not (zerop (setq r (vla-get-Rotation obj))))
         (progn
           (vla-put-rotation (setq nobj (vla-copy obj)) 0.0)
           (vla-getBoundingBox nobj 'll 'ur)

           (RotateByMatrix              
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))

             (GetTextIns obj) r)
           
           (vla-put-layer Poly layer)
           (vla-put-Closed Poly :vlax-true)
           (vla-delete nobj))

         (progn
           (vla-getBoundingBox obj 'll 'ur)
           (vla-put-layer
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))
             layer)
           
           (vla-put-Closed Poly :vlax-true)))

       (if (setq iLst
                  (apply (function append)
                    (vl-remove-if (function null)
                      (mapcar
                        (function
                          (lambda (object)
                            (GroupByNum
                              (vlax-invoke Poly
                                'IntersectWith object acExtendNone) 3)))
                        
                        (vl-remove obj
                          (ss->VLA
                            (cond (  (ssget "_C" (trans (caddr bBox) 0 1)
                                                 (trans (car bBox)   0 1)

                                            FiltLst)))))))))
         
         (progn
           (vla-put-color Poly acRed)
           (mapcar (function Point) iLst))

         (vla-put-color Poly acGreen)))

     (vla-delete ss)
     (setq uFlag (vla-EndUndoMark doc))))

 (princ))

Hi Ewan,

 

If you are aware of ssget filter lists, then this will help.

 

I have added an option to the top of the list to specify which objects to filter out/in when comparing the text.

 

Hi Lee,

Thanks so much for your help.

Now I'm sure I'm showing my ignorance here but I cant seem to make the filter list work. I've tried the following solutions and every variation I can think of (e.g. each layer as a literal string (8. "STSS-CL-M") and each layer mask as a seperate entry e.g. (8. "????-CL-?") (8. ""????-HB-?") and it just doesn't seem to be working as I would expect.

(setq FiltLst '((-4 . "<NOT") 
(0 . "VIEWPORT") 
(8 . "????-CL-?,????-ZZ-?,????-ZZ-?,????-LN-?,????-HB-?")  
(-4 . "NOT>")))

Sorry to ask but could you help me clarify this?

Ewan

Not a problem Ewan, happy to help.

I have updated the code since to allow for locked/frozen layers,

Give this a shot (filters out *text also).

(defun c:overlap (/ *error* RotateByMatrix AddLwPoly BBox->List GroupByNum GetTextIns Point

                   ALLOBJS BBOX DOC FILTLST ILST LAYER LL NOBJ POLY PT R SPC SS UFLAG UR)
 
 ;; Lee Mac  ~  15.03.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))    
 
 (setq layer "OverLapCheck")

[color=Red][b]  (setq FiltLst '((-4 . "<NOT")
                   (-4 . "<OR")
                     (0 . "VIEWPORT,*TEXT")
                     (8 . "????-CL-?,????-ZZ-?,????-ZZ-?,????-LN-?,????-HB-?")
                   (-4 . "OR>")
                 (-4 . "NOT>")))[/b][/color]

 (defun RotateByMatrix (obj pt ang / RotationMatrix Vector)
   ;; Rotation by Matrix  ~  Lee Mac 

   (setq RotationMatrix (list (list (cos ang) (- (sin ang))  0.0)
                              (list (sin ang)    (cos ang)   0.0)
                              (list    0.0           0.0     1.0)))

   (setq Vector (mapcar (function -) pt
                        (mapcar
                          (function
                            (lambda (row) (apply (function +)
                                                 (mapcar (function *) row pt))))
                          RotationMatrix)))
   (vla-transformby obj
     (vlax-tmatrix
       (append
         (mapcar
           (function
             (lambda (r x) (append r (list x))))

           RotationMatrix Vector)

         '((0.0 0.0 0.0 1.0))))))
 

 (defun AddLWPoly (blk lst)
   (vla-AddLightWeightPolyline blk
     (vlax-make-variant
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble
           (cons 0 (1- (* 2 (length lst)))))
         (apply (function append) lst)))))
 

 (defun BBox->List (ll ur)
   (list (list (car ll) (cadr ll))
         (list (car ll) (cadr ur))
         (list (car ur) (cadr ur))
         (list (car ur) (cadr ll))))
 

 (defun GroupByNum (lst num / rtn)
   (setq rtn nil)
   
   (if lst
     (cons (reverse
             (repeat num
               (progn
                 (setq rtn (cons (car lst) rtn)
                       lst (cdr lst))
                 rtn)))
           
           (GroupByNum lst num))))
 

 (defun GetTextIns (object)
   (vlax-get object
     (if (eq "AcDbText" (vla-get-ObjectName object))
       (if (eq acAlignmentLeft (vla-get-Alignment object))
         'InsertionPoint 'TextAlignmentPoint)
       'InsertionPoint)))
 

 (defun Point (pt)
   (entmakex (list (cons 0 "POINT")
                   (cons 8 layer)
                   (cons 10 pt)                    
                   (cons 62 2))))
 

 (defun SS->VLA (ss / i e lst)
   (setq i -1)
   (if ss
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq lst (cons (vlax-ename->vla-object e) lst))))
   
   lst)  
 

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object))

       spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                   (eq :vlax-true   (vla-get-MSpace doc)))
             (vla-get-ModelSpace doc)
             (vla-get-PaperSpace doc)))  

 (or (tblsearch "LAYER" layer)
     (vla-add (vla-get-layers doc) layer))

 (setq AllObjs (ss->VLA (ssget "_X" FiltLst)))
 
 (if (ssget '((0 . "TEXT,MTEXT,INSERT")))
   (progn
     (setq uFlag (not (vla-StartUndoMark doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))

       (if (not (zerop (setq r (vla-get-Rotation obj))))
         (progn
           (vla-put-rotation (setq nobj (vla-copy obj)) 0.0)
           (vla-getBoundingBox nobj 'll 'ur)

           (RotateByMatrix              
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))

             (GetTextIns obj) r)
           
           (vla-put-layer Poly layer)
           (vla-put-Closed Poly :vlax-true)
           (vla-delete nobj))

         (progn
           (vla-getBoundingBox obj 'll 'ur)
           (vla-put-layer
             (setq Poly
               (AddLWPoly spc
                 (setq bBox
                   (apply (function BBox->List)
                          (mapcar (function vlax-safearray->list)
                                  (list ll ur))))))
             layer)
           
           (vla-put-Closed Poly :vlax-true)))

       (if (setq iLst
                  (apply (function append)
                    (vl-remove-if (function null)
                      (mapcar
                        (function
                          (lambda (object)
                            (GroupByNum
                              (vlax-invoke Poly
                                'IntersectWith object acExtendNone) 3)))
                        
                        (vl-remove obj AllObjs)))))
         
         (progn              
           (vla-put-color Poly acRed)
           (mapcar (function Point) iLst))

         (vla-put-color Poly acGreen)))

     (vla-delete ss)
     (setq uFlag (vla-EndUndoMark doc))))

 (princ))

FYI, the latest version of this program can be found here.

Lee