Jump to content

circles and arcs to excel


MajorTom

Recommended Posts

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

Link to comment
Share on other sites

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

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 by hanhphuc
commented by dlnorh sort length ascending
  • Like 1
Link to comment
Share on other sites

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 😛

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

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 by hanhphuc
  • Like 1
Link to comment
Share on other sites

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.

  • Like 1
Link to comment
Share on other sites

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 by hanhphuc
  • Like 2
Link to comment
Share on other sites

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

  • Like 1
Link to comment
Share on other sites

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)

 

4pAlk0.jpg

how can i solve this bigal thank you by the way

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

Link to comment
Share on other sites

40 minutes ago, MajorTom said:

4pAlk0.jpg

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.

  • Like 1
Link to comment
Share on other sites

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by BIGAL
Link to comment
Share on other sites

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)

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

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 🤓

Link to comment
Share on other sites

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

  • Like 1
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...