ewan_m Posted March 15, 2010 Share Posted March 15, 2010 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 Catalog the height and widths of all used fonts in lower and uppercase (of which I have about 50) manually Use that as a lookup to determine the size of any given string in any given font at any given size 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 15, 2010 Share Posted March 15, 2010 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 Quote Link to comment Share on other sites More sharing options...
ewan_m Posted March 15, 2010 Author Share Posted March 15, 2010 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 15, 2010 Share Posted March 15, 2010 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)) Quote Link to comment Share on other sites More sharing options...
ewan_m Posted March 15, 2010 Author Share Posted March 15, 2010 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. Quote Link to comment Share on other sites More sharing options...
lpseifert Posted March 15, 2010 Share Posted March 15, 2010 Very nice Lee... But did you know of the Tspaceinvaders command? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 15, 2010 Share Posted March 15, 2010 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 15, 2010 Share Posted March 15, 2010 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)) Quote Link to comment Share on other sites More sharing options...
ewan_m Posted March 16, 2010 Author Share Posted March 16, 2010 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 16, 2010 Share Posted March 16, 2010 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)) Quote Link to comment Share on other sites More sharing options...
ewan_m Posted March 17, 2010 Author Share Posted March 17, 2010 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 17, 2010 Share Posted March 17, 2010 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)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 18, 2010 Share Posted March 18, 2010 FYI, the latest version of this program can be found here. Lee Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.