Lisp to export Line length and nearest text to excel

[asdfgh]

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

[exceed]

 

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

[asdfgh]

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

[exceed]

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

[asdfgh]

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  

[hosneyalaa]

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

 

[exceed]

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