Lisp添加每行合计（&T）

tzframpton · 发表于 2022-7-6 08:07:07

大家好，我以前看过Lisp例程，在那里可以选择多行和/或PLINE，它将累加总长度。尝试在这里搜索，但我想我没有任何运气。。。。有人能指出一个吗？提前谢谢。如果没有，不用担心，只要想一件我们办公室的评估人员可能感兴趣的事情。。。。

ReMark · 发表于 2022-7-6 08:15:51

向下滚动至测量和尺寸G。它叫elen。lsp。

http://www.asmitools.com/Files/Programs.html

感谢阿斯米！

David Bethel · 发表于 2022-7-6 08:24:51

或者这1：

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

-大卫

mdbdesign · 发表于 2022-7-6 08:26:30

或者这个。。。
莱伦。lsp
莱伦。DCL

Commandobill · 发表于 2022-7-6 08:33:19

或者这一个将它们提取到excel中

copy

(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!"))
 )

alanjt · 发表于 2022-7-6 08:40:29

这是一个迫切需要更新，但我只是太懒了，没有使用它太多，但由于每个人都张贴他们的，我只是认为我会是一个帮派的一部分。

stevesfr · 发表于 2022-7-6 08:43:14

有一天请更新并包括“圈”请！
（为什么不从以前开始？）
S

alanjt · 发表于 2022-7-6 08:50:50

我想这是你可以用的东西。
我想我今晚会坐下来做一个更新，在孩子睡觉后，我会做的。添加圆形。

因为我是弱智。不久前，我非常需要它，写了它，用了几次，但还没有真正接触过它。我的一个朋友一直在使用它进行竣工调查。

今晚，我至少会添加圆圈并修复单位。

nish · 发表于 2022-7-6 08:59:42

大家好，我有类似的代码，但我有一些问题。

问题是它计算图形中所有多段线的长度。
我希望它只根据我的选择计算多段线的长度，并按层将总数发送到excel。

我目前的代码如下所示：

copy

(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 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***\t  Type PLE to write polines length to Excel\t***")
(princ)

BIGAL · 发表于 2022-7-6 09:01:20

我的5美分价值

[编程交流] Lisp添加每行合计（&T）

发表回复

精选推荐