Export coordinates of selected object (arc or line) to excel

danijel.radenkovic · ‎02-17-2017

Hello to all,

I believe there is a script, lisp, vb.net application or whatever, which recognize type of selected object (arc or line) and export object's coordinates.

For arcs, I would like to export start point, center of arc and end point. For lines I would like to export start and end point.

Attached example of connected arcs and line represents my problem.

Any help is very appreciated.

Danijel

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

ВeekeeCZ · ‎02-17-2017

Try following code. Some things that you can adjust yourself.

- in your country is a CSV file separated by a comma or a semicolon? Used comma

- do you want to z coords?

- lines are presented with 0 0 0 for the center point.

(vl-load-com)

(defun c:LA2CSV ( / *error* file i en pe pm pb)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if file (close file))
    (princ))

  (if (and (setq ss (ssget '((0 . "LINE,ARC"))))
           (setq file (open (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-CooExport.csv") "a"))
           (write-line "x1,y1,z1,xm,ym,zm,x2,y2,z2" file)										; delimiter
           )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
            pb (vlax-curve-getStartPoint en)
            pe (vlax-curve-getEndPoint en)
            pm (if (= "ARC" (cdr (assoc 0 (entget en))))
                 (cdr (assoc 10 (entget en)))
                 '(0 0 0)))
      			  ;x			  y			z
      (write-line (strcat (rtos (car pb) 2 8) "," (rtos (cadr pb) 2 8) "," (rtos (last pb) 2 8) ","					; delimiter
                          (rtos (car pm) 2 8) "," (rtos (cadr pm) 2 8) "," (rtos (last pm) 2 8) ","					; delimiter
                          (rtos (car pe) 2 8) "," (rtos (cadr pe) 2 8) "," (rtos (last pe) 2 8)						; delimiter
                          ) file)))
  (princ (strcat "\nFile exported: "(getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-CooExport.csv"))
  (*error* "end")
)

danijel.radenkovic · ‎02-17-2017

@ВeekeeCZ wrote:

Try following code. Some things that you can adjust yourself.

- in your country is a CSV file separated by a comma or a semicolon? Used comma

- do you want to z coords?

- lines are presented with 0 0 0 for the center point.

-it works fine as I expected with "."

-I don't need z coords, just x and y

-it is ok

One thing that I would like to change is to export points into the opened excel doc starting from the A1 cell every time. If I open already filled sheet with data (coordinates), it has to clear all sheet and export new values starting from the first cell.

Thank you!

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

ВeekeeCZ · ‎02-17-2017

Sure.

My first question wasn't about the decimal delimiter but the column delimiter. But lets keep it.

No sure if you want the heading line or not - see the code, erase or keep the initial semicolon.

(vl-load-com)

(defun c:LA2CSV ( / *error* file i pb pm pe en)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if file (close file))
    (princ))

  (if (and (setq ss (ssget '((0 . "LINE,ARC"))))
           (setq file (open (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-CooExport.csv") "w"))
          ; (write-line "x1,y1,xm,ym,x2,y2" file)				; heading
           )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
            pb (vlax-curve-getStartPoint en)
            pe (vlax-curve-getEndPoint en)
            pm (if (= "ARC" (cdr (assoc 0 (entget en))))
                 (cdr (assoc 10 (entget en)))
                 '(0 0 0)))
      			  ;x			  y
      (write-line (strcat (rtos (car pb) 2 8) "," (rtos (cadr pb) 2 8) "," 					; delimiter
                          (rtos (car pm) 2 8) "," (rtos (cadr pm) 2 8) ","					; delimiter
                          (rtos (car pe) 2 8) "," (rtos (cadr pe) 2 8)						; delimiter
                          ) file)))
  (princ (strcat "\nFile exported: "(getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-CooExport.csv"))
  (*error* "end")
)

danijel.radenkovic · ‎02-17-2017

@ВeekeeCZ wrote:

Sure.

My first question wasn't about the decimal delimiter but the column delimiter. But lets keep it.

No sure if you want the heading line or not - see the code, erase or keep the initial semicolon.

I agree to keep column delimiter. Heading line is ok and I will keep it (I have erased red code). The only thing that I noticed is that it doesn't work with the opened .csv (as it is showed on the video). Also, I have never used .csv files but standard .xsl and .xlsx documents cause Inventor allows me to import only those two extensions.

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

ВeekeeCZ · ‎02-17-2017

I wasn't meant for that. I've found this @patrick_35's example which works with open Excel sheet.

For some reason (probably a country specific - comma vs semicolon) the original HERE exports just the x coordinates.

I've made some modifications in the code to accept ACRs as well, but Y coord you need to add by yourself - if this solution works for you better.

Good luck

; by patrick_35
; mods by beekeecz

(vl-load-com)

(defun c:test(/ doc ent lin xls wks)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (and (ssget '((0 . "LINE,ARC")))
    (progn
      (setq xls (vlax-get-or-create-object "Excel.Application"))
      (or (setq wks (vlax-get xls 'ActiveSheet))
	(vlax-invoke (vlax-get xls 'workbooks) 'Add)
      )
      (setq wks (vlax-get xls 'ActiveSheet)
	    lin 2
      )
      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "StartPoint-X")
      (vlax-put (vlax-get-property wks 'range "B1") 'value "EndPoint-X")
      (vlax-put (vlax-get-property wks 'range "C1") 'value "Center-X")
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 1 0)))
	(vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (car (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                                                       '(0 0 0))))
        (setq lin (1+ lin))
      )
      (vla-delete sel)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
    )
  )
  (vla-endundomark doc)
  (princ)
)

danijel.radenkovic · ‎02-17-2017

I have tried to figure out the code and to make similar for Y coordinates but I have some difficulties to understand cause I am not professional users of lisp.

      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "StartPoint-X")
      (vlax-put (vlax-get-property wks 'range "C1") 'value "EndPoint-X")
      (vlax-put (vlax-get-property wks 'range "E1") 'value "Center-X")
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 1 0)))
	(vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (car (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                     					'(0 0 0))))

Here what I have tried:

	(vlax-put xls 'Visible :vlax-true)
	(vlax-put (vlax-get-property wks 'range "B1") 'value "StartPoint-Y")
      	(vlax-put (vlax-get-property wks 'range "D1") 'value "EndPoint-Y")
     	 (vlax-put (vlax-get-property wks 'range "F1") 'value "Center-Y")
      	(vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 0 1)))
	(vlax-put (vlax-get-property wks 'range (strcat "D" (itoa lin))) 'value (car (trans (vlax-get ent 'endpoint) 0 1)))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 0 1)
                                                                                       '(0 0 0))))

Where I am doing something wrong?

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

ВeekeeCZ · ‎02-17-2017

Last 1 0 keep as it is - its from the TRANS function, see HERE

You need to change car to cadr. See my first routine - you dealing with the coordinates in list '(x y z). car takes the first one, cadr the second... see HERE and other links down the page.

danijel.radenkovic · ‎02-17-2017

; by patrick_35
; mods by beekeecz

(vl-load-com)

(defun c:test(/ doc ent lin xls wks)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (and (ssget '((0 . "LINE,ARC")))
    (progn
      (setq xls (vlax-get-or-create-object "Excel.Application"))
      (or (setq wks (vlax-get xls 'ActiveSheet))
	(vlax-invoke (vlax-get xls 'workbooks) 'Add)
      )
      (setq wks (vlax-get xls 'ActiveSheet)
	    lin 2
      )
      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "StartPoint-X")
      (vlax-put (vlax-get-property wks 'range "C1") 'value "EndPoint-X")
      (vlax-put (vlax-get-property wks 'range "E1") 'value "Center-X")
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 1 0)))
	(vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (car (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                      					'(0 0 0))))
	(vlax-put xls 'Visible :vlax-true)
	(vlax-put (vlax-get-property wks 'range "B1") 'value "StartPoint-Y")
      	(vlax-put (vlax-get-property wks 'range "D1") 'value "EndPoint-Y")
     	 (vlax-put (vlax-get-property wks 'range "F1") 'value "Center-Y")
      	(vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (cadr (trans (vlax-get ent 'startpoint) 1 0)))
	(vlax-put (vlax-get-property wks 'range (strcat "D" (itoa lin))) 'value (cadr (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (cadr (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                                                       '(0 0 0))))

	(setq lin (1+ lin))
      )
      (vla-delete sel)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
    )
  )
  (vla-endundomark doc)
  (princ)
)

I am getting the answer (error) "nil".

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

ВeekeeCZ · ‎02-17-2017

; by patrick_35
; mods by beekeecz

(vl-load-com)

(defun c:test(/ doc ent lin xls wks)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (and (ssget '((0 . "LINE,ARC")))
    (progn
      (setq xls (vlax-get-or-create-object "Excel.Application"))
      (or (setq wks (vlax-get xls 'ActiveSheet))
	(vlax-invoke (vlax-get xls 'workbooks) 'Add)
      )
      (setq wks (vlax-get xls 'ActiveSheet)
	    lin 2
      )
      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "StartPoint-X")
      (vlax-put (vlax-get-property wks 'range "B1") 'value "StartPoint-Y")
      (vlax-put (vlax-get-property wks 'range "C1") 'value "EndPoint-X")
      (vlax-put (vlax-get-property wks 'range "D1") 'value "EndPoint-Y")
      (vlax-put (vlax-get-property wks 'range "E1") 'value "Center-X")
      (vlax-put (vlax-get-property wks 'range "F1") 'value "Center-Y")
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (cadr (trans (vlax-get ent 'startpoint) 1 0)))
	(vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (car (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "D" (itoa lin))) 'value (cadr (trans (vlax-get ent 'endpoint) 1 0)))
        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                      					'(0 0 0))))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (cadr (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                                                       '(0 0 0))))
        (setq lin (1+ lin))
      )
      (vla-delete sel)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
    )
  )
  (vla-endundomark doc)
  (princ)
)

danijel.radenkovic · ‎02-17-2017

That's it!

Thank you. I am looking into the code where I made mistake. Very appreciate your help!

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

danijel.radenkovic · ‎02-22-2017

Hello to all,

Apologize for my return on the this topic but I my question is close related to it. I would like to find a way to round the values of coordinates (for example on 6 decimals) before I export it to excel. Excel give me abilities to round it but just "visual", real value is still with many decimals.

Any help is very appreciated.

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

CADaSchtroumpf · ‎02-22-2017

Hi,

You can simply change

(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (car (trans (vlax-get ent 'startpoint) 1 0)))

to

(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (read (rtos (car (trans (vlax-get ent 'startpoint) 1 0)) 2 5)))

Make same for "B","C","D","E","F": (read (rtos .... 2 5)), 5 is precision, put what you wont!

danijel.radenkovic · ‎02-22-2017

Hello,

I have changed as you adviced but I really don't know why it doesn't work. Am I doing something wrong with the editing?

(vl-load-com)

(defun c:Pera(/ doc ent lin xls wks)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (and (ssget '((0 . "LINE,ARC")))
    (progn
      (setq xls (vlax-get-or-create-object "Excel.Application"))
      (or (setq wks (vlax-get xls 'ActiveSheet))
	(vlax-invoke (vlax-get xls 'workbooks) 'Add)
      )
      (setq wks (vlax-get xls 'ActiveSheet)
	    lin 2
      )
      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "StartPoint-X")
      (vlax-put (vlax-get-property wks 'range "B1") 'value "StartPoint-Y")
      (vlax-put (vlax-get-property wks 'range "C1") 'value "EndPoint-X")
      (vlax-put (vlax-get-property wks 'range "D1") 'value "EndPoint-Y")
      (vlax-put (vlax-get-property wks 'range "E1") 'value "Center-X")
      (vlax-put (vlax-get-property wks 'range "F1") 'value "Center-Y")
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (read (rtos (car (trans (vlax-get ent 'startpoint) 1 0)) 2 5)))
        (vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (read (rtos (cadr (trans (vlax-get ent 'startpoint) 1 0)) 2 5)))
	(vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (read (rtos (car (trans (vlax-get ent 'endpoint) 1 0)) 2 5)))
        (vlax-put (vlax-get-property wks 'range (strcat "D" (itoa lin))) 'value (read (rtos (cadr (trans (vlax-get ent 'endpoint) 1 0)) 2 5)))
        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (read (rtos (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0) 2 5))
                                                      					'(0 0 0))))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (read (rtos (cadr (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0) 2 5))
                                                                                       '(0 0 0))))
        (setq lin (1+ lin))
      )
      (vla-delete sel)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
    )
  )
  (vla-endundomark doc)
  (princ)
)

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

CADaSchtroumpf · ‎02-22-2017

For "E" and "F", you have misplaced the argument of (rtos)

        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (read (rtos (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                      					'(0 0 0))) 2 5)))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (read (rtos (cadr (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                                                       '(0 0 0))) 2 5)))

danijel.radenkovic · ‎02-22-2017

@CADaSchtroumpf wrote:

For "E" and "F", you have misplaced the argument of (rtos)

        (vlax-put (vlax-get-property wks 'range (strcat "E" (itoa lin))) 'value (read (rtos (car (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                      					'(0 0 0))) 2 5)))
        (vlax-put (vlax-get-property wks 'range (strcat "F" (itoa lin))) 'value (read (rtos (cadr (if (= "AcDbArc" (vlax-get ent 'objectname))
                                                                                       (trans (vlax-get ent 'center) 1 0)
                                                                                       '(0 0 0))) 2 5)))

I see now where I made mistake.

Thank you very much!

Danijel

Inventor 2018/Windows 10 x64
If this information was helpful, please consider marking it as an Accepted Solution by using the Accept as Solution. Kudos are also gladly accepted.

Community

Export coordinates of selected object (arc or line) to excel

Export coordinates of selected object (arc or line) to excel

Export coordinates of selected object (arc or line) to excel