双脚到米口齿不清?
你好我不精通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) 此外,如果可能,是否可以编辑LISP,以便除了显示多段线图层、单个长度和总长度外,CSV还显示与每个多段线相关的对象数据(每个多段线都附有对象数据格式的属性)
提前感谢 请阅读代码发布指南并使用代码标签,我现在已经修复了你的帖子。
对于第一个问题,似乎包含了度量部分,用;;;;注释掉了它;;;。
您只需要注释掉第一个(我会为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]