circles and arcs to excel

November 1, 2019

Hi,

I need a lisp which can export only circles and arcs length to excel.

And when doing this must sort them by low length to high length.

for example first five rows of the excel file which will create with lisp :

Rank Length Type

1 25 circle

2 33 circle

3 41 arc

4 54 circle

As you can see five rows are like this. Five, that's mean that excel file must include titles either

thanks in advance.

I really appreciate all of you

trully regards

Major Tom

November 2, 2019

Try this you need to set up the correct file path for output, makes a csv file open in excel. Remove the remark ; to run once path is set.

(defun c:test ( / x y lay lst fo )
(setq lay (vla-get-layer (vlax-ename->vla-object (car (entsel "Pick Arc.circ for layer")))))
(setq ss (ssget (list (cons 0 "Arc,circle")(cons 8 lay))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(if (= (vla-get-objectname obj) "AcDbCircle")
(progn 
(setq len (vla-get-circumference obj))
(setq id "Circle")
)
(progn 
(setq len (vla-get-arclength obj))
(setq id "ARC")
)
)
(setq lst (cons (list id len) lst))
)
(setq lst (vl-sort lst '(lambda (x y)
(< (cadr x)(cadr y)))
))
(alert "ok now write a csv file you must change path below")
(setq lst (reverse lst))
(setq y 1)
(setq fo (open (setq fname "C:\\yourdiredctory\\yourfilename.csv") "w"))
(write-line "Rank,Length,Type" fo)
(repeat (setq x (length lst))
(setq ans (nth (setq x (- x 1)) lst))
(write-line (strcat (rtos y 2 0) "," (car ans) "," (rtos (cadr ans) 2 2)) fo)
(setq y (+ y 1))
)
(close fo)
)
(vl-load-com)
(c:test)

Edited November 9, 2019 by BIGAL

November 4, 2019

can't be make like this for xls file

November 4, 2019

Is double clicking on the csv to hard ?

November 4, 2019

3 hours ago, BIGAL said:

Is double clicking on the csv to hard ?

;(setq fo (open (setq fname "C:\\yourdiredctory\\yourfilename.csv") "w"))
;(write-line "Rank,Length,Type" fo)
;(repeat (setq x (length lst))
;(setq ans (nth (setq x (- x 1)) lst))
;(write-line (strcat (rtos y 2 0) "," (car ans) "," (rtos (cadr ans) 2 2)) fo)
;(setq y (+ y 1))
;)
;(close fo)

@BIGAL just notice you have commented ";" in your code , that's why it doesn't write file

here's another quick & dirty using vlax-curve- function

(defun c:CA (/ *error* l ls f fn i ss fn)
  (defun *error* (msg)
    (if (= (type f) 'FILE)
      (close f)
      )
    (terpri)
    )
    
  (if (and (setq i  0
                 ss (ssget "_X" (list '(0 . "ARC,CIRCLE") (cons 410 (getvar 'CTAB))))
                 )
           (setq ls (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))));(acet-ss-to-list ss)) 
           (setq fn (vl-filename-mktemp "CA.csv"))
           (setq f (open fn "W"))
           (write-line "Rank,Length,Type" f)
           )
    (progn (setq i  0
                 l  (mapcar ''((x)
                               (list (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x)) (cdr (assoc 0 (entget x))))
                               )
                            ls
                            )
                 ls (vl-sort l ''((a b) (< (car a) (car b))))
                 )
           (foreach x ls
             (write-line
               (apply 'strcat
                      (mapcar ''((x) (strcat x ",")) (list (itoa (setq i (1+ i))) (rtos (car x) 2) (cadr x)))
                      )
               f
               )
             )
           (if (= (type f) 'FILE)
             (close f)
             )
      (vl-cmdf "_START" fn)
           )
    (princ "\nOops.. Nothing?")
    )
  (princ)
  )

Edited November 5, 2019 by hanhphuc
commented by dlnorh sort length ascending

November 5, 2019

17 minutes ago, hanhphuc said:


;(setq fo (open (setq fname "C:\\yourdiredctory\\yourfilename.csv") "w"))
;(write-line "Rank,Length,Type" fo)
;(repeat (setq x (length lst))
;(setq ans (nth (setq x (- x 1)) lst))
;(write-line (strcat (rtos y 2 0) "," (car ans) "," (rtos (cadr ans) 2 2)) fo)
;(setq y (+ y 1))
;)
;(close fo)

@BIGAL just notice you have commented ";" in your code , that's why it doesn't write file

here's another quick & dirty using vlax-curve- function


(defun c:CA (/ *error* en f i ss fn)

  (defun *error* (msg)
    (if (= (type f) 'FILE)
      (close f)
      )
    (terpri)
    )
  
  (if (and (setq i  0
                 ss (ssget "_X" (list '(0 . "ARC,CIRCLE") (cons 410 (getvar 'CTAB))))
                 )
           (setq n (sslength ss))
           (setq fn (vl-filename-mktemp "CA.csv"))
           (setq f (open fn "W"))
           (write-line "Rank,Length,Type" f)
           )
    (progn
    (while (< i n)
      (setq en (ssname ss i))
      (write-line
        (apply 'strcat
               (mapcar ''((x) (strcat x ","))
                       (list (itoa (setq i (1+ i)))
                             (rtos (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2)
                             (cdr (assoc 0 (entget en)))
                             )
                       )
               )
        f
        )
      )
    (if (=(type f)'FILE) (close f) )
    ;;; (vl-cmdf "_SHELL" (strcat "explorer \""fn"\"") )
    (vl-cmdf "_START" fn)
    )
    (princ "\nOops..Nothing?")
    )
  (*error* nil)
  (princ)
  )
  
  (c:CA)

Missing the "sort by length" ascending

November 5, 2019

1 hour ago, dlanorh said:

Missing the "sort by length" ascending

oops.. thanks

If OP knows EXCEL well, just get it sorted in opened csv file

select range (example=$A$1:$C$6) -> insert Table -> sort A-Z at column 'length' -> renumber 'column 'Rank'

Edited November 5, 2019 by hanhphuc

November 5, 2019

Thanks guys not sure how I missed that.

November 5, 2019

Can't you open the file in excel using

(startapp "excel.exe" fname)

or something similar?

The braincell is telling me there is a method but I can't put my finger on it at the moment.

November 5, 2019

49 minutes ago, dlanorh said:
Can't you open the file in excel using
(startapp "excel.exe" fname)
or something similar?

The braincell is telling me there is a method but I can't put my finger on it at the moment.

(startapp "EXPLORER" fname ) ;; open full path fname using its default app

FWIW If what you mean similar without COM API, normally just use command START or SHELL

(command "_START" "EXCEL")

Edited November 5, 2019 by hanhphuc

November 5, 2019

47 minutes ago, hanhphuc said:

(startapp "EXPLORER" fname ) ;; open full path fname using its default app

FWIW If what you mean similar without COM API, normally just use command START or SHELL

(command "_START" "EXCEL")

Thanks @hanhphuc

November 5, 2019

On 11/2/2019 at 3:20 AM, BIGAL said:

Try this you need to set up the correct file path for output, makes a csv file open in excel. Remove the remark ; to run once path is set.


(defun c:test ( / x y lay lst fo )
(setq lay (vla-get-layer (vlax-ename->vla-object (car (entsel "Pick Arc.circ for layer")))))
(setq ss (ssget (list (cons 0 "Arc,circle")(cons 8 lay))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(if (= (vla-get-objectname obj) "AcDbCircle")
(progn 
(setq len (vla-get-circumference obj))
(setq id "Circle")
)
(progn 
(setq len (vla-get-arclength obj))
(setq id "ARC")
)
)
(setq lst (cons (list id len) lst))
)
(setq lst (vl-sort lst '(lambda (x y)
(< (cadr x)(cadr y)))
))
(alert "ok now write a csv file you must change path below")
(setq lst (reverse lst))
(setq y 1)
(setq fo (open (setq fname "C:\\yourdiredctory\\yourfilename.csv") "w"))
(write-line "Rank,Length,Type" fo)
(repeat (setq x (length lst))
(setq ans (nth (setq x (- x 1)) lst))
(write-line (strcat (rtos y 2 0) "," (car ans) "," (rtos (cadr ans) 2 2)) fo)
(setq y (+ y 1))
)
(close fo)
)
(c:test)

how can i solve this bigal thank you by the way

thanks all of you guys for helping people who needs help like me

November 5, 2019

40 minutes ago, MajorTom said:

how can i solve this bigal thank you by the way

thanks all of you guys for helping people who needs help like me

Put

(vl-load-com)

At the top of Al's file and reload, unless you are running on a MAC. If you are going to use lisp, it might be an idea to put this into one of the lisps that load automatically when AutoCAD starts, that way it is always there.

November 5, 2019

I probably should add (vl-load-com) to every file.

Also remove the "alert" line once paths are changed, it just so many times people do not understand that the code must be changed to save the file.

Ps (command "_START" "EXCEL C:/yourdiredctory/yourfilename.csv") will open the file

Edited November 5, 2019 by BIGAL

November 8, 2019

On 11/6/2019 at 1:58 AM, BIGAL said:

I probably should add (vl-load-com) to every file.

Also remove the "alert" line once paths are changed, it just so many times people do not understand that the code must be changed to save the file.

Ps (command "_START" "EXCEL C:/yourdiredctory/yourfilename.csv") will open the file

Hi again

Actually aI put the vl-load-com but still error comes in front of me

https://i.hizliresim.com/5N0zZM.jpg

November 9, 2019

Just copy and paste the code to notepad edit the destination file then save the file. Just drag and drop onto Autocad it will load.

Note this will not work with plines

Paste this line onto command line, pick circles and arcs

(setq ss (ssget (list (cons 0 "Arc,circle"))))

then type (sslength ss) a number should appear if not then you do not have circles and arcs but something else.

This will not work also if you have a MAC.

Post a sample dwg.

Edited November 9, 2019 by BIGAL

November 10, 2019

You may wish to consider the following code:

(defun c:c2xl ( / *error* col enx flg hed idx lst row sel typ xls xlsapp xlscls xlswbk xlswbs xlswsh )

    (setq hed '("Rank" "Length" "Type")) ;; Column headings
    
    (defun *error* ( msg )
        (if (and flg (= 'vla-object (type xlsapp)))
            (vl-catch-all-apply 'vlax-invoke-method (list xlsapp 'quit))
        )
        (foreach obj (list xlscls xlswsh xlswbk xlswbs xlsapp)
            (if (and (= 'vla-object (type obj)) (not (vlax-object-released-p obj)))
                (vlax-release-object obj)
            )
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (cond
        (   (not
                (and
                    (setq sel (ssget '((0 . "ARC,CIRCLE"))))
                    (setq xls (getfiled "Create Excel File" "" "xlsx;xls" 1))
                )
            )
        )
        (   (progn
                (repeat (setq idx (sslength sel))
                    (setq idx (1- idx)
                          enx (entget (ssname sel idx))
                          typ (strcase (cdr (assoc 0 enx)) t)
                          lst
                        (cons
                            (list
                                (*  (cdr (assoc 40 enx))
                                    (if (= "circle" typ)
                                        (+ pi pi)
                                        (rem (+ pi pi (- (cdr (assoc 51 enx)) (cdr (assoc 50 enx)))) (+ pi pi))
                                    )
                                )
                                typ
                            )
                            lst
                        )
                    )
                )
                (not
                    (or (setq xlsapp (vlax-get-object "excel.application"))
                        (and (setq xlsapp (vlax-create-object "excel.application"))
                             (setq flg t)
                        )
                    )
                )
            )
            (princ "\nUnable to interface with Excel application.")
        )
        (   t
            (setq xlswbs (vlax-get-property  xlsapp 'workbooks)
                  xlswbk (vlax-invoke-method xlswbs 'add)
                  xlswsh (vlax-get-property  xlswbk 'activesheet)
                  xlscls (vlax-get-property  xlswsh 'cells)
            )
            (setq col 0)
            (foreach itm hed
                (vlax-put-property xlscls 'item 1 (setq col (1+ col)) itm)
                (vlax-put-property
                    (vlax-get-property
                        (vlax-variant-value (vlax-get-property xlscls 'item 1 col))
                        'font
                    )
                    'bold :vlax-true
                )
            )
            (setq row 1)
            (foreach itm (vl-sort lst '(lambda ( a b ) (< (car a) (car b))))
                (setq row (1+ row)
                      col 0
                )
                (foreach val (cons (1- row) itm)
                    (vlax-put-property xlscls 'item row (setq col (1+ col)) val)
                )
            )
            (if (and (< "11.0" (vlax-get-property xlsapp 'version))
                     (= (strcase (vl-filename-extension xls) t) ".xlsx")
                )
                (vlax-invoke-method xlswbk 'saveas xls    51 "" "" :vlax-false :vlax-false 1 1)
                (vlax-invoke-method xlswbk 'saveas xls -4143 "" "" :vlax-false :vlax-false 1 1)
            )
            (vlax-invoke-method xlswbk 'close :vlax-false)
        )
    )
    (*error* nil)
    (princ)
)
(vl-load-com) (princ)

November 10, 2019

nice example Lee, had small issue with diffent excel versions with a 'little lunch time appie' and your code elegantly takes this into account. Thank for yet another lesson master Lee

November 10, 2019

3 hours ago, rlx said:

nice example Lee, had small issue with diffent excel versions with a 'little lunch time appie' and your code elegantly takes this into account. Thank for yet another lesson master Lee

Thanks @rlx, glad it helps.

Sign In

circles and arcs to excel

Recommended Posts

MajorTom

BIGAL

MajorTom

BIGAL

hanhphuc

dlanorh

hanhphuc

BIGAL

dlanorh

hanhphuc

dlanorh

MajorTom

dlanorh

BIGAL

MajorTom

BIGAL

Lee Mac

rlx

Lee Mac

Join the conversation

Tutorials

Forums

Activity