Extract Coordinates to Table

Extract Coordinates to Table

cadgeek33
Contributor Contributor
265 Views
5 Replies
Message 1 of 6

Extract Coordinates to Table

cadgeek33
Contributor
Contributor

Hi,

 

Could anyone assist me with a LISP routine? I've attached a sample drawing for reference. I need a similar output: a table listing the coordinates of polyline edges in a format like the sample, with a column for number labels. I will assign the numbers manually. Currently, we obtain these coordinates through data extraction, which is time-consuming. We have many similar items, so an automated solution would be ideal. Any help or guidance would be greatly appreciated.

 

Thank You.

0 Likes
Accepted solutions (1)
266 Views
5 Replies
Replies (5)
Message 2 of 6

Moshe-A
Mentor
Mentor

@cadgeek33 hi,

 

This not so hard to do but have you notice to this:

you put 101 not at the pline start point and the next pline point goes to the opposite direction.

so can the label points be automatic? 

 

Moshe

0 Likes
Message 3 of 6

cadgeek33
Contributor
Contributor

I am afraid, it is on the line. Numbering will be done manually. Numbering Text alignment coordinates should be on the table which is the edge of polyline.

0 Likes
Message 4 of 6

Moshe-A
Mentor
Mentor

@cadgeek33 

 

i am not sure you got me (or i did not you 😀) if you want full control on labeling, instead of simple text insert a block with attribute and the insertion point lay exactly on the vertex. this also will skip unwanted vertices if they are found. this way the list of points will be done directly from the blocks (and not from the polyline)

 

Moshe

 

0 Likes
Message 5 of 6

Moshe-A
Mentor
Mentor
Accepted solution

@cadgeek33 ,

 

check this XYTAB command.

 

enjoy,

Moshe

 

(defun c:xytab (/ adoc modelSpace ss p0 p10 p11 data^ i AcDbTable ename elist)
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (setq modelSpace (vla-get-ModelSpace adoc))
 
 (if (and
       (not (prompt "\nSelect polyline labels..."))
       (setq ss (ssget '((0 . "text"))))
       (setq p0 (getpoint "\nTable upper left corner: "))
     )
  (progn
   (setq data^
   	(mapcar
     	  (function
       	    (lambda (ename / label)
	      (setq label (cdr (assoc '1 (entget ename))))
              (cons label ename)
            ); lambda
          ); function 
         (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        ); mapcar
   ); setq

   (setq AcDbTable (vla-Addtable modelSpace (vlax-3d-point (trans p0 1 0)) (+ (vl-list-length data^) 2) 3 0.5 1.7))

   (setq i 0)
   (vla-setText AcDbTable i 0 "PLINE COORDS LIST")
   (setq i (1+ i))
   (vla-setText AcDbTable i 0 "BCN-NO")
   (vla-setText AcDbTable i 1 "EASTING")
   (vla-setText AcDbTable i 2 "NORTHING")

   (vla-setAlignment AcDbTable acTitleRow  acMiddleCenter)
   (vla-setAlignment AcDbTable acHeaderRow acMiddleCenter)
   (vla-setAlignment AcDbTable acDataRow   acMiddleCenter)

   (vla-setColumnWidth AcDbTable 0 1.3)

   (foreach item (vl-sort data^ (function (lambda (e0 e1) (< (car e0) (car e1))))) ; sort
    (setq i (1+ i))
     
    (setq ename (cdr item))
    (setq elist (entget ename))
    (setq p10 (cdr (assoc '10 elist)))

    (if (not (setq p11 (cdr (assoc '11 elist))))
     (setq p11 p10)
    )
     
    (vla-setText AcDbTable i 0 (car item))
    (vla-setText AcDbTable i 1 (rtos (car p11) 2 3))
    (vla-setText AcDbTable i 2 (rtos (cadr p11) 2 3))
   ); foreach
     
   (vlax-release-object AcDbTable)
  ); progn
 ); if

 (vlax-release-object modelSpace)
 (vlax-release-object adoc)
  
 (princ)
)

 

 

 

Message 6 of 6

cadgeek33
Contributor
Contributor

Thanks a lot Moshe. Works well. 🤗

0 Likes