[编程交流] 双脚到米Lisp程序？

(defun c:ple (/        elist         en          i           layer    layer_list
        leng         pline          row           ss            sumlen   total
        x         xlApp          xlBook   xlBooks  xlCells  xlSheet
        xlSheets
       )
 (vl-load-com)
 (setq        xlApp           (vlax-get-or-create-object "Excel.Application")
xlBooks  (vlax-get-property xlApp "Workbooks")
xlBook           (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet           (vlax-get-property xlSheets "Item" 1)
xlCells           (vlax-get-property xlSheet "Cells")
 ) 
 (vla-put-visible xlApp :vlax-true)
 ;headers
 (vlax-put-property xlCells "Item" 1 1 "Layer")
 (vlax-put-property xlCells "Item" 1 2 "Length")
 
 (setq row 2
total 0)
 (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)
 (repeat (sslength ss)
   (setq en (ssname ss (setq i (1+ i)))
  elist (entget en)
  layer (cdr (assoc 8 elist)))
   (if (not (member layer layer_list))
     (setq layer_list (cons layer layer_list))))
 
 
 (repeat (length layer_list)
   (setq layer (car layer_list))
   (vlax-put-property xlCells "Item" row 1 layer)
   (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
   (repeat (sslength ss)
   (setq row (1+ row))  
   (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
   (setq leng  (vlax-curve-getdistatparam pline
          (vlax-curve-getendparam pline)))
   (vlax-put-property xlCells "Item" row 2 (rtos leng 4 3))
   ;;;    (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units  
   (setq sumlen (+ sumlen leng)))
   (setq row (1+ row))
   (vlax-put-property xlCells "Item" row 1 "SubTotal:")
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 4 3))
   (setq total (+ total sumlen))
;;;    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
   (setq layer_list (cdr layer_list))
   (setq row (+ row 2))
   
 ) 
; footers:
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 4 3))
;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units  
(mapcar (function (lambda(x)
            (vl-catch-all-apply
              (function (lambda()
                          (progn
                            (vlax-release-object x)
                            (setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Close Excel file manually")
(gc)(gc)

(vlax-put-property xlCells "Item" row 2 (rtos leng 4 3))
   ;;;    (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units 

;;;  (vlax-put-property xlCells "Item" row 2 (rtos leng 4 3)); for Imperial units
(vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units