lisp选择所有图案填充，然后

SWfangirl · 发表于 2022-7-6 09:15:24

你好
我的同事发现这个Lisp程序，它似乎不能正常工作。老实说，我对lisp的了解还不够，无法理解。正如标题所述，它应该选择图形中的所有图案填充，然后计算总面积。如果有人能帮我，我将不胜感激。同样，这不是我们两人写的东西，而是在autodesk讨论组中找到的。当我加载它时，这就是我得到的错误；错误：没有函数定义：VLAX-ENAME->VLA-OBJECT

copy

[font=Times New Roman][size=3](defun c:HatchAreas (/ sset i area obj)[/size][/font]
[size=3][font=Times New Roman](if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)[/font][/size]
[size=3][font=Times New Roman](progn[/font][/size]
[size=3][font=Times New Roman](prompt "\nSelect hatches: ")[/font][/size]
[size=3][font=Times New Roman](if (setq sset (ssget '((0 . "hatch"))))[/font][/size]
[size=3][font=Times New Roman](progn[/font][/size]
[size=3][font=Times New Roman](setq[/font][/size]
[size=3][font=Times New Roman]i (1- (sslength sset))[/font][/size]
[size=3][font=Times New Roman]area 0)[/font][/size]
[size=3][font=Times New Roman](while (>= i 0)[/font][/size]
[size=3][font=Times New Roman](setq[/font][/size]
[size=3][font=Times New Roman]obj (vlax-ename->vla-object (ssname sset i))[/font][/size]
[size=3][font=Times New Roman]area (+ area (vla-get-area obj)))[/font][/size]
[size=3][font=Times New Roman](setq i (1- i)))[/font][/size]
[size=3][font=Times New Roman](alert[/font][/size]
[size=3][font=Times New Roman](strcat[/font][/size]
[size=3][font=Times New Roman]"\nTotal area = "[/font][/size]
[size=3][font=Times New Roman](if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))[/font][/size]
[size=3][font=Times New Roman](strcat[/font][/size]
[size=3][font=Times New Roman](rtos area 2)[/font][/size]
[size=3][font=Times New Roman]" sq. in. ("[/font][/size]
[size=3][font=Times New Roman](rtos (/ area 144) 2)[/font][/size]
[size=3][font=Times New Roman]" sq. ft.)")[/font][/size]
[size=3][font=Times New Roman](rtos area))))))))[/font][/size]
[size=3][font=Times New Roman](princ))[/font][/size]

Tharwat · 发表于 2022-7-6 09:21:20

检查这个，伙计。

copy

(defun c:Test (/ ar ss sset i vl e)
 ;; Tharwat 27. 06. 2011
 (setq ar 0)
 (vl-load-com)
 (if
   (setq ss (ssget "_x" '((0 . "HATCH"))))
    (repeat
      (setq i (sslength ss))
       (setq sset (ssname ss (setq i (1- i))))
       (setq vl (vlax-ename->vla-object sset))
       (setq e (entget sset))
       (setq ar (+ ar (vla-get-area vl)))
    )
    (princ)
 )
 (alert
   (strcat "\n"
           (strcat "Area of Hatches :" " " (rtos ar 2))
   )
 )
 (princ)
)