Sideshow-Cad 发表于 2022-7-5 18:09:44

双脚到米口齿不清?

你好
 
我不精通LISP语言。
 
有人可以编辑以下内容吗。lsp对我来说,将生成的电子表格从英尺和英寸更改为米?
 
提前谢谢。
 
 
(defun c:ple (/        elist       en          i           layer    layer_list
        leng       pline          row           ss          sumlen   total
        x       xlApp          xlBook   xlBooksxlCellsxlSheet
        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)

Sideshow-Cad 发表于 2022-7-5 18:44:00

此外,如果可能,是否可以编辑LISP,以便除了显示多段线图层、单个长度和总长度外,CSV还显示与每个多段线相关的对象数据(每个多段线都附有对象数据格式的属性)
 
提前感谢

SLW210 发表于 2022-7-5 19:20:05

请阅读代码发布指南并使用代码标签,我现在已经修复了你的帖子。
 
对于第一个问题,似乎包含了度量部分,用;;;;注释掉了它;;;。
 
您只需要注释掉第一个(我会为Imperial添加注释),然后删除;;;从公制版本前面。
 
例子:
 
电流:
(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
页: [1]
查看完整版本: 双脚到米Lisp程序?