Jump to content

The length at the midpoint was written by Lee Mac. I want to help add the function to export to Excel

quyenpv

By quyenpv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

quyenpv Rookie

quyenpv

Posted
Posted

I found a Lisp that records the length at the midpoint written by Lee Mac (Length at Midpoint). I want to help write an additional function that outputs Excel the length of the selected object to a Sheet of information including order, object, length. After the statement ends, if the user continues to execute, write the next result from the last line of Sheet
I also found the list to export to Excel but I don't know how to edit it to make the lisp as complete as I want it to be 

; 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)
)

 

MidLenV1-1 (1).lsp Test.lsp

Link to comment
Share on other sites
devitg Experienced

devitg

Posted
Posted
7 hours ago, quyenpv said:

I found a Lisp that records the length at the midpoint written by Lee Mac (Length at Midpoint). I want to help write an additional function that outputs Excel the length of the selected object to a Sheet of information including order, object, length. After the statement ends, if the user continues to execute, write the next result from the last line of Sheet
I also found the list to export to Excel but I don't know how to edit it to make the lisp as complete as I want it to be 

; 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)
)

 

MidLenV1-1 (1).lsp 7.55 kB · 1 download Test.lsp 2.37 kB · 2 downloads

@quyenpv please upload sample.dwg

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Excel has a few combos to do with is already open or not so can check this. Easiest is to not have excel open and let your code open it. Or have a blank excel open. 

  

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

The reason I mention this is your using the ADD function and it may not be necessary. Its possibly better to open or check what file is open if you want to add a new worksheet. 

 

You can use (alert "make sure Excel is closed") this will stop Acad while you check. 

 

(setq myxl (vlax-get-object "Excel.Application"))
nil No Excel is open so can use this as a check

 (setq myxl (vlax-get-object "Excel.Application"))
#<VLA-OBJECT _Application 000000006C4CC198>  Excel is open so can get say file name and check and use or make a new one.

Link to comment
Share on other sites
quyenpv Rookie

quyenpv

Posted
  • Author
Posted

Because this statistics is not necessary to store, if the first time excel does not have the program, it will start and create a Workbook and add a new Sheet. If yes, then add information to Sheet
There is a need to fix more here
1. Check the box to insert data, if there is old data, ask the user if he wants to overwrite it
2. If in Autocad run the command n times after the first time, the results will continue to be recorded in the last line of Sheet

Link to comment
Share on other sites
quyenpv Rookie

quyenpv

Posted
  • Author
Posted 
(vl-load-com)

(defun c:test(/ doc ent lin xls wks rng)
  (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))
      (vlax-put xls 'Visible :vlax-true)
      (setq rng (vlax-get (vlax-get wks 'UsedRange) 'Rows))
      (setq lin (1+ (vla-get-count rng))) ; Add 1 to the count to get the next empty row
      (if (= lin 2) ; If the Excel file is empty, we create headers
        (progn
          (vlax-put (vlax-get-property wks 'range "A1") 'value "Object Order")
          (vlax-put (vlax-get-property wks 'range "B1") 'value "Object Length")
          (setq lin 2)
        )
      )
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
        (vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (- lin 1)) ; We start from 1
        (vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (rtos (vla-get-length ent) 2 2)) ; Round the length to 2 decimal places
        (setq lin (1+ lin))
      )
      (vla-delete sel)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Link to comment
Share on other sites
Tsuky Enthusiast

Tsuky

Posted
Posted

For Arc is not Length but ArcLength, you must change 

(vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (rtos (vla-get-length ent) 2 2)) ; Round the length to 2 decimal places

to 

(vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (rtos (if (eq (vla-get-objectname ent) "AcDbLine") (vla-get-length ent) (vla-get-arclength ent)) 2 2)) ; Round the length to 2 decimal places

 

Link to comment
Share on other sites
quyenpv Rookie

quyenpv

Posted
  • Author
Posted

I want to combine the lisp written by Lee Mac with exporting to Excel so that when selecting an object, I simultaneously record the length of the object into Autocad and output it to Excel at the same time.

Link to comment
Share on other sites
devitg Experienced

devitg

Posted
Posted
9 hours ago, quyenpv said:

I want to combine the lisp written by Lee Mac with exporting to Excel so that when selecting an object, I simultaneously record the length of the object into Autocad and output it to Excel at the same time.

@quyenpv Would you accept a CSV file , it can be open by XLS , and it will be easy to implement , it will add new line each time you use.

Please upload a xls sample as you need the columns to be. 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

"I simultaneously record the length into Autocad and output it to Excel at the same time."

 

Yes "putcell" function. 

  

(vlax-put (vlax-get-property wks 'range "D21" 'value length))

 

Ok now for the part you need when working in Autocad think rows and columns, ie 20,5 would be row 20 column 5, but in excel its "E20". So the solution is convert x,y to alphanumber.

 

I would look at Getexcel.lsp for the answer it is in there, and use it with your existing code.

 

I use a home grown version which started with getexcel.lsp. This is my put cell function. 

(defun putcell (cellname val1 / )
(setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
(vlax-put-property myRange 'Value2 val1)
)

So here is a hint, its in Getexcel.lsp needed for cellname. 

; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"

getexecel.lsp

 

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.

×
 Share
Go to topic listing
×
×
  • Create New...