sanjeeve Posted January 14, 2017 Share Posted January 14, 2017 Anybody extract text from this blocks. new block.dwg Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted January 14, 2017 Share Posted January 14, 2017 You can do it with the _ATTEXT command. Quote Link to comment Share on other sites More sharing options...
gS7 Posted January 15, 2017 Share Posted January 15, 2017 or DATAEXTRACTION Quote Link to comment Share on other sites More sharing options...
gS7 Posted January 15, 2017 Share Posted January 15, 2017 (edited) Try this link you can extract attributes values http://www.lee-mac.com/macatt.html excellent program by Mr.lee mac and my version (quick and dirty ) (defun c:test (/ s attr tagstr atblks i txtstr txtpos) (vl-load-com) (if (setq atblks (ssget '((0 . "INSERT") (66 . 1)))) (progn (repeat (setq i (sslength atblks)) (setq enm (vlax-ename->vla-object (ssname atblks (setq i (1- i)))) ) (setq attr (vlax-safearray->list (vlax-variant-value (vla-getattributes enm)) ) ) (foreach d attr (setq tagstr (vla-get-tagstring d) txtstr (vla-get-textstring d) txtpos (vla-get-TextAlignmentPoint d) ) (entmake (list (cons 0 "TEXT") (cons 1 (strcat tagstr "=" txtstr)) (cons 10 (vlax-safearray->list (vlax-variant-value txtpos)) ) (cons 40 0.2) (cons 50 0.314159) ) ) ) ) ) ) (princ) ) Edited January 15, 2017 by gS7 Multiple selection Quote Link to comment Share on other sites More sharing options...
Grrr Posted January 15, 2017 Share Posted January 15, 2017 Heres my attempt (something like NCOPY for attributes): (defun C:test ( / e AcSpc Props Atts) (setvar 'errno 0) (while (/= 52 (getvar 'errno)) (setq e (car (entsel "\nPick attributed block <exit>: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed.") (setvar 'errno 0) ) ( (and e (/= "INSERT" (cdr (assoc 0 (entget e)))) ) (princ "\nThis is not a block.") ) ( (and e (/= 1 (cdr (assoc 66 (entget e)))) ) (princ "\nThis Block is not attributed.") ) ( e (setq AcSpc (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))) (setq Props (list 'TextAlignmentPoint 'TextString 'Height 'Rotation 'ScaleFactor 'StyleName 'Alignment 'InsertionPoint)) (setq Atts (mapcar (function (lambda (x) (mapcar '(lambda (p) (vlax-get x p)) Props))) (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes) )) (mapcar '(lambda (x / o) (if (setq o (vla-AddMtext AcSpc (vlax-3D-point '(0. 0. 0.)) 0 "ABC")) (mapcar (function (lambda (a b) (cond ( (= a 'Alignment) (setq a 'AttachmentPoint) (setq b (cadr (assoc b '((7 1) (8 2) (9 3) (10 4) (11 5) (12 6) (13 7) (14 (15 9))))) ) ) (and b (vl-catch-all-apply 'vlax-put (list o a b))) ) ) Props x ) ) ) Atts ) (setvar 'errno 52) ) ); cond ); while (princ) ); defun C:test Still has text justification issues. Quote Link to comment Share on other sites More sharing options...
sanjeeve Posted January 16, 2017 Author Share Posted January 16, 2017 Thanks for the help it works:) Quote Link to comment Share on other sites More sharing options...
satishrajdev Posted January 17, 2017 Share Posted January 17, 2017 With little variation :- (defun c:test (/ a b) (vl-load-com) (if (setq a (ssget '((0 . "INSERT") (66 . 1)))) (progn (repeat (setq i (sslength a)) (setq b (vlax-ename->vla-object (ssname a (setq i (1- i))))) (foreach x (vlax-invoke b 'getattributes) (entmake (list (cons 0 "TEXT") (cons 1 (strcat (vla-get-tagstring x) "=" (vla-get-textstring x) ) ) (cons 10 (vlax-get x 'textalignmentpoint)) (cons 40 (vla-get-height x)) (cons 50 (vla-get-rotation x)) ) ) ) ) ) ) (princ) ) 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.