Jump to content

Lisp to export Line length and nearest text to excel


Recommended Posts

Posted

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

Posted

 

‘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.

  • Like 1
Posted
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

Posted (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 by exceed
  • Like 1
Posted
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 image.png.04c344049d594d2bccdbaa902e40f013.png 

Posted

@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)))

 

  • Like 1
Posted (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 by exceed
  • Thanks 1

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...