大家好，(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)(princ) )(princ "\t\t***\t Type PLE to write polines length to Excel\t***")(princ) 
置顶卡
