Lisp添加每行合计（&T）
大家好，我以前看过Lisp例程，在那里可以选择多行和/或PLINE，它将累加总长度。尝试在这里搜索，但我想我没有任何运气。。。。有人能指出一个吗？提前谢谢。如果没有，不用担心，只要想一件我们办公室的评估人员可能感兴趣的事情。。。。 向下滚动至测量和尺寸G。它叫elen。lsp。http://www.asmitools.com/Files/Programs.html
感谢阿斯米！ 或者这1：
http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F
-大卫 或者这个。。。
莱伦。lsp
莱伦。DCL 或者这一个将它们提取到excel中
(defun c:ple (/ layer layer_list leng row ss sumlen total xlApp xlCells)
(vl-load-com)
(if (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))))
(progn
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add")
"Sheets")
"Item" 1)
"Cells"))
(vla-put-visible xlApp :vlax-true)
(vlax-put-property xlCells "Item" 1 1 "Layer")
(vlax-put-property xlCells "Item" 1 2 "Length")
(setq row 2
total 0)
(mapcar '(lambda (z)
(if (not (member z layer_list))
(setq layer_list (append (list z) layer_list))))
(mapcar '(lambda (z) (cdr (assoc 8 (entget z)))) (mapcar 'cadr (ssnamex ss))))
(repeat (length layer_list)
(setq layer (car layer_list))
(setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) sumlen 0)
(mapcar '(lambda (z) (setq sumlen (+ sumlen (vla-get-length (vlax-ename->vla-object (cadr z)))))) (ssnamex ss))
(vlax-put-property xlCells "Item" row 1 layer)
(vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
(setq total (+ total sumlen))
(setq layer_list (cdr layer_list))
(setq row (+ row 1))
)
(setq row (+ row 1))
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
(vlax-release-object xlApp)
(alert "Close Excel file manually")
(gc)(gc)
(princ)
) (alert "There are no Polylines on your drawing!"))
)
这是一个迫切需要更新，但我只是太懒了，没有使用它太多，但由于每个人都张贴他们的，我只是认为我会是一个帮派的一部分。
有一天请更新并包括“圈”请！
（为什么不从以前开始？）
S
我想这是你可以用的东西。
我想我今晚会坐下来做一个更新，在孩子睡觉后，我会做的。添加圆形。
因为我是弱智。不久前，我非常需要它，写了它，用了几次，但还没有真正接触过它。我的一个朋友一直在使用它进行竣工调查。
今晚，我至少会添加圆圈并修复单位。 大家好，我有类似的代码，但我有一些问题。
问题是它计算图形中所有多段线的长度。
我希望它只根据我的选择计算多段线的长度，并按层将总数发送到excel。
我目前的代码如下所示：
(defun c:ple (/ elisten i layer layer_list
lengpline row ss sumlen total
xxlApp 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 2 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 2 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 2 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***\tType PLE to write polines length to Excel\t***")
(princ)
我的5美分价值
页:
[1]
2