Jump to content

Export text and its nearest line coordinate to csv


bills

Recommended Posts

Hi All

 

I am looking for a lisp program using which i can export to excel all the text (or selected text) and nearest line coordinate to that text having angle of inclination varies by  +/- 10degree to text angle.

 

Can anyone help me out.

 

Thanks in advance. This will simply my task to a great extent.

Edited by bills
Link to comment
Share on other sites

My requirement is explained in attached images.

 

When i select text in cad, it should detect its nearest line whose angle is similar as text rotation and export the details in csv file.

 

Hope it clarifies.

Capture.PNG

Capture1.PNG

Link to comment
Share on other sites

A dwg would help as to find the line is easy but need to know the distance of the text to the line this limits the searching to fing hopefull 1 only.

Link to comment
Share on other sites

Generally my drawing units are mm hence the maximum distance of line from text could be restricted to 2000 units and yes i want only 1 result for each text. If there is no line near to text then it should report an error message like "No Line detected"

Link to comment
Share on other sites

I tried to write this routine taking help of other routines, but couldn't success.

Can anyone correct it.

 

 

(vl-load-com)
(setq very_big_number 2000)
(setq csvpath "D:\\Text1.csv")  ;; Adapt this to your needs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, e?lse nil

(defun LM:writecsv ( lst csv / des sep )
    (if (setq des (open csv "w"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (foreach row lst (write-line (LM:lst->csv row sep) des))
            (close des)
            t
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(defun LM:lst->csv ( lst sep )
    (if (cdr lst)
        (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
        (LM:csv-addquotes (car lst) sep)
    )
)

(defun LM:csv-addquotes ( str sep / pos )
    (cond
        (   (wcmatch str (strcat "*[`" sep "\"]*"))
            (setq pos 0)    
            (while (setq pos (vl-string-position 34 str pos))
                (setq str (vl-string-subst "\"\"" "\"" str pos)
                      pos (+ pos 2)
                )
            )
            (strcat "\"" str "\"")
        )
        (   str   )
    )
)

(defun pline_length ( ent / a obj sum)
  (vla-get-length (vlax-ename->vla-object ent))
)

(defun c:elc ( / mtexts plines text ip i j ind pts eol pt2 data)
  ;; get MTexts
  (setq mtexts  (ssget "_x" (list '(0 . "TEXT"))))
  ;; Polylines
  (setq plines  (ssget "_x" (list '(0 . "LWPOLYLINE,POLYLINE,LINE"))))
 
  (setq i 0)
  (setq data (list (list "text" "length" "x head" "y head" "x point 2" "y point 2" "x tail" "y tail")))
 
  (repeat (sslength mtexts)
    (setq text (ssname mtexts i))
    (setq ip (cdr (assoc 10 (entget text))))
    
    ;; now search for the nearest polyline
    (setq
      j 0
      ind -1  ;; index of the matching text
      inf very_big_number  ;; a big number, we search for a better match
    )
    (repeat (sslength plines)
      (princ "\n")
      (setq pt2 (vlax-curve-getClosestPointTo (ssname plines j) (nth 0 pts) ))  
      (if (< (distance (nth 0 pts) pt2) inf)
        (progn
          (setq inf (distance (nth 0 pts) pt2))
          (setq ind j)
        )
      )       
      (setq j (+ j 1))
    )
    ;; we have all the data for this row (for 1 leader)
    ;; the (rtos) is to convert numbers to string.  The csv expects string values
    (setq data (append data (list (list
      (cdr (assoc 1 (entget (ssname mtexts ind))))  ;; text
      
      (rtos (pline_length (ssname plines ind)) 2 4)           ;; polyline length
    ))))
    
    (setq i (+ i 1))
  )

  (if
    (LM:writecsv data csvpath)
    (princ "\nSuccessful")
    (princ "\nFailed")
  )
  (princ)
)

Link to comment
Share on other sites

On 24/04/2019 at 06:28, bills said:

My requirement is explained in attached images.

 

When i select text in cad, it should detect its nearest line whose angle is similar as text rotation and export the details in csv file.

 

Hope it clarifies.

Capture.PNG

Capture1.PNG

 

The excel in this image doesn't match up with this presumably "header" line of code

(setq data (list (list "text" "length" "x head" "y head" "x point 2" "y point 2" "x tail" "y tail")))

 

You're explanation mentions text entities and lines, yet you are attempting to select lwpolyline and polylines. LWPolylines and Polylines can have multiple segments and in the case of a Polyline entity be curved and or have an elevation.

 

Perhaps a better explanation of your requirements are needed, including whether the user  needs to select the text and lines or all texts and lines can be selected automatically.

 

Edited by dlanorh
Link to comment
Share on other sites

Like dlanorh its easy to do a little search around the text object and find something. The smaller the search area the better. using the text height is one way to get the search area.

Link to comment
Share on other sites

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