asdfgh Posted September 6, 2023 Share Posted September 6, 2023 Hi everyone, I have a drawings with lines and texts, some lines have text near to it and other lines have no text near to them, i am wondering if anyone have a lisp to export text and line length only for lines near texts to excel. Anyone have a similar lisp ? Thank you Quote Link to comment Share on other sites More sharing options...
exceed Posted September 6, 2023 Share Posted September 6, 2023 ‘Near’ is a human friendly word. It must be described so that the machine can understand how close it is. generally Lines can be long, and text is not that long. so, you need to know where to find the text in line, around starting point, midpoint, and endpoint or something. Since the text is not a single pair with a line, you need to specify a bounding rectangle and capture it, like you would select text in CAD. In the best case, the text insertion point is located exactly above the line. You also need to be aware of various factors to consider, such as if there is a back dwg excluding the relevant objects in the drawing or text that should not be selected, if lines intersect, or if there are multiple lines in the radius around the text. It would be good if the general formula could be described in sufficient detail but cannot, the best thing to do is to attach a sample drawing. 1 Quote Link to comment Share on other sites More sharing options...
asdfgh Posted September 6, 2023 Author Share Posted September 6, 2023 5 minutes ago, exceed said: ‘Near’ is a human friendly word. It must be described so that the machine can understand how close it is. generally Lines can be long, and text is not that long. so, you need to know where to find the text in line, around starting point, midpoint, and endpoint or something. Since the text is not a single pair with a line, you need to specify a bounding rectangle and capture it, like you would select text in CAD. In the best case, the text insertion point is located exactly above the line. You also need to be aware of various factors to consider, such as if there is a back dwg excluding the relevant objects in the drawing or text that should not be selected, if lines intersect, or if there are multiple lines in the radius around the text. It would be good if the general formula could be described in sufficient detail but cannot, the best thing to do is to attach a sample drawing. Thank you for your reply. Here is a dwg for reference new block.dwg Quote Link to comment Share on other sites More sharing options...
exceed Posted September 6, 2023 Share Posted September 6, 2023 (edited) 3 hours ago, asdfgh said: Thank you for your reply. Here is a dwg for reference new block.dwg 84.03 kB · 0 downloads (defun C:FOO (/ *error* thisdrawing scalefactor ss ssl index outputtxt ssl ent obj ts box lll url th p1 p2 ss2 lent lobj llen lentxt ) (vl-load-com) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark thisdrawing) (princ) ) (vla-EndUndoMark thisdrawing) (vla-startundomark thisdrawing) (defun ex:@setclipboardtext (text / htmlfile result) (setq htmlfile (vlax-create-object "htmlfile")) (vlax-release-object htmlfile) (setq htmlfile (vlax-create-object "htmlfile")) (setq result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow) 'ClipBoardData) 'SetData "Text" text ) ) (vlax-release-object htmlfile) text ) (setq scalefactor 2) ; you can adjust this. (princ "\n select texts") (if (setq ss (ssget '((0 . "TEXT")))) ; if you want with no user selection, replace with this, (if (setq ss (ssget "X" '((0 . "TEXT")))) (progn (setq ssl (sslength ss)) (setq index 0) (setq outputtxt "") (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq ts (vlax-get-property obj 'textstring)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (setq th (vlax-get-property obj 'height)) (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) 0.0)) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) 0.0)) (if (setq ss2 (ssget "c" p1 p2 '((0 . "LINE")))) (progn (setq lent (ssname ss2 0)) (setq lobj (vlax-ename->vla-object lent)) (setq llen (vlax-get-property lobj 'length)) (setq lentxt (vl-princ-to-string llen)) ) (progn (setq lentxt "there's no line") ) ) (setq outputtxt (strcat outputtxt (if (= index 0) "" "\r\n") ts "\t" lentxt)) (setq index (+ index 1)) ) (ex:@setclipboardtext outputtxt) (princ "\n copy complete. you can paste it to excel.") ) (progn (princ "\n there's no text.") ) ) (vla-EndUndoMark thisdrawing) (princ) ) you can start with this Edited September 6, 2023 by exceed 1 Quote Link to comment Share on other sites More sharing options...
asdfgh Posted September 6, 2023 Author Share Posted September 6, 2023 50 minutes ago, exceed said: (defun C:FOO (/ *error* thisdrawing scalefactor ss ssl index outputtxt ssl ent obj ts box lll url th p1 p2 ss2 lent lobj llen lentxt ) (vl-load-com) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark thisdrawing) (princ) ) (vla-EndUndoMark thisdrawing) (vla-startundomark thisdrawing) (defun ex:@setclipboardtext (text / htmlfile result) (setq htmlfile (vlax-create-object "htmlfile")) (vlax-release-object htmlfile) (setq htmlfile (vlax-create-object "htmlfile")) (setq result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow) 'ClipBoardData) 'SetData "Text" text ) ) (vlax-release-object htmlfile) text ) (setq scalefactor 2) ; you can adjust this. (princ "\n select texts") (if (setq ss (ssget '((0 . "TEXT")))) ; if you want with no user selection, replace with this, (if (setq ss (ssget "X" '((0 . "TEXT")))) (progn (setq ssl (sslength ss)) (setq index 0) (setq outputtxt "") (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq ts (vlax-get-property obj 'textstring)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (setq th (vlax-get-property obj 'height)) (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) (caddr tc))) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) (caddr tc))) (if (setq ss2 (ssget "c" p1 p2 '((0 . "LINE")))) (progn (setq lent (ssname ss2 0)) (setq lobj (vlax-ename->vla-object lent)) (setq llen (vlax-get-property lobj 'length)) (setq lentxt (vl-princ-to-string llen)) ) (progn (setq lentxt "there's no line") ) ) (setq outputtxt (strcat outputtxt (if (= index 0) "" "\r\n") ts "\t" lentxt)) (setq index (+ index 1)) ) (ex:@setclipboardtext outputtxt) (princ "\n copy complete. you can paste it to excel.") ) (progn (princ "\n there's no text.") ) ) (vla-EndUndoMark thisdrawing) (princ) ) you can start with this Thank you for your reply. I don't know is it me or not but the lisp gives this error Quote Link to comment Share on other sites More sharing options...
hosneyalaa Posted September 6, 2023 Share Posted September 6, 2023 @exceed @asdfgh I don't know << tc >> indicate A problem with it (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) (caddr tc))) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) (caddr tc))) 1 Quote Link to comment Share on other sites More sharing options...
exceed Posted September 6, 2023 Share Posted September 6, 2023 (edited) 2 hours ago, hosneyalaa said: @exceed @asdfgh I don't know << tc >> indicate A problem with it (setq p1 (list (- (car lll) (* scalefactor th)) (- (cadr lll) (* scalefactor th)) (caddr tc))) (setq p2 (list (+ (car url) (* scalefactor th)) (+ (cadr url) (* scalefactor th)) (caddr tc))) ah my mistake thank you for comments. at first time i use tc (insertion coordinates) points for calculation i was changed that tc with boundingbox but didn't change that so just change (caddr tc) with 0.0 or (caddr lll) is will be okay i will update code in above. because now im going to home now > code updated and tested in acad2023 Edited September 6, 2023 by exceed 1 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.