Lisp编辑-多边形区域

Peu · 发表于 2022-7-6 09:36:08

大家好！

我通常通过朋友的帐号进入论坛。但现在我真的需要你的帮助。

我发现了一个非常好的lisp，它可以获取多段线的面积，并使用字段属性插入多段线，字段属性的文本大小与注释预设中的文本大小相同。唯一的问题是，它将测量显示为平方英尺，但在Autocad 2011 x64上运行良好。

这是我找到的Lisp命令：

copy

 
;;; AreaText.LSP ver 3.0
;;; Command name is AT
;;; Select a polyline and where to place the text
;;; Sample result: 2888.89 sq ft
;;; As this is a FIELD it is updated based on the FIELDEVAL
;;; or the settings found in the OPTIONS dialog box
;;; By Jimmy Bergmark
;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved
;;; Website: [url="http://www.jtbworld.com/"]www.jtbworld.com[/url]
;;; E-mail: [email="info@jtbworld.com"]info@jtbworld.com[/email]
;;; 2007-09-05 - First release
;;; 2009-08-02 - Updated to work in both modelspace and paperspace
;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD
;;; Uses TEXTSIZE for the text height
(defun Get-ObjectIDx64 (obj / util)
 (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (if (= (type obj) 'VLA-OBJECT)
   (if (> (vl-string-search "x64" (getvar "platform")) 0)
     (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
     (rtos (vla-get-objectid obj) 2 0)
   )
 )
)
(defun c:AT (/ entObject entObjectID InsertionPoint ad)
 (vl-load-com)
 (setq entObject (vlax-ename->vla-object(car (entsel)))
       entObjectID (Get-ObjectIDx64 entObject)
       InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
       ad (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (vla-addMText (if (= 1 (vla-get-activespace ad))
   (vla-get-modelspace ad)
   (if (= (vla-get-mspace ad) :vlax-true)
     (vla-get-modelspace ad)
     (vla-get-paperspace ad)
   )
 )
 InsertionPoint 0.0 (strcat
 "####"
 ))
)

如果有人能帮我更改这个lisp，使其仅以平方米（sufix为“m²”）显示度量值，我将不胜感激。

我在某处找到这句话，我不知道它是否有用：

copy

 
   ("%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] "(rtos objID 2 0)">%).Area [url="file://f/"]\\f[/url] "%lu2%pr1%ps[Area , m sq]%ct8[1e-006]">%")

非常感谢你！

SLW210 · 发表于 2022-7-6 09:44:24

你需要使用代码标签，只要选择（#），你就会得到

copy

<p> </p><p>Have you tried jtbworld?</p>

Peu · 发表于 2022-7-6 09:51:04

SLW210，
我刚用“on codes”更改了帖子。Sry。我还发现在jtbworld上的代码，没有以米为单位的区域代码，用这样的字段属性显示结果。

线程：

大家好！

我通常通过朋友的帐号进入论坛。但现在我真的需要你的帮助。

我发现了一个非常好的lisp，它可以获取多段线的面积，并使用字段属性插入多段线，字段属性的文本大小与注释预设中的文本大小相同。唯一的问题是，它将测量显示为平方英尺，但在Autocad 2011 x64上运行良好。

这是我找到的Lisp命令：

copy

 
;;; AreaText.LSP ver 3.0
;;; Command name is AT
;;; Select a polyline and where to place the text
;;; Sample result: 2888.89 sq ft
;;; As this is a FIELD it is updated based on the FIELDEVAL
;;; or the settings found in the OPTIONS dialog box
;;; By Jimmy Bergmark
;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved
;;; Website: [url="http://www.jtbworld.com"]www.jtbworld.com[/url]
;;; E-mail: [email="info@jtbworld.com"]info@jtbworld.com[/email]
;;; 2007-09-05 - First release
;;; 2009-08-02 - Updated to work in both modelspace and paperspace
;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD
;;; Uses TEXTSIZE for the text height
(defun Get-ObjectIDx64 (obj / util)
 (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (if (= (type obj) 'VLA-OBJECT)
   (if (> (vl-string-search "x64" (getvar "platform")) 0)
     (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
     (rtos (vla-get-objectid obj) 2 0)
   )
 )
)
(defun c:AT (/ entObject entObjectID InsertionPoint ad)
 (vl-load-com)
 (setq entObject (vlax-ename->vla-object(car (entsel)))
       entObjectID (Get-ObjectIDx64 entObject)
       InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
       ad (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (vla-addMText (if (= 1 (vla-get-activespace ad))
   (vla-get-modelspace ad)
   (if (= (vla-get-mspace ad) :vlax-true)
     (vla-get-modelspace ad)
     (vla-get-paperspace ad)
   )
 )
 InsertionPoint 0.0 (strcat
 "####"
 ))
)

如果有人能帮我更改这个lisp，使其仅以平方米（sufix为“m²”）显示度量值，我将不胜感激。

我在某处找到了这句话，我不知道它是否有用：

copy

 
   ("%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] "(rtos objID 2 0)">%).Area [url="file://f/"]\\f[/url] "%lu2%pr1%ps[Area , m sq]%ct8[1e-006]">%")

非常感谢你！

Cad64 · 发表于 2022-7-6 09:57:41

我已经批准了你的帖子。由于你发布的代码中有多个链接，他们由论坛软件主持。

Peu · 发表于 2022-7-6 10:03:52

谢谢CAD64，我以为我做错了什么=）

我估计我就快到了。。。我试图更改一些行，但仍然无法插入度量值，因为我无法插入前缀（面积=）

这是目前为止的最后一个版本：

copy

 
;;; AreaText.LSP ver 3.0
;;; Command name is AT
;;; Select a polyline and where to place the text
;;; Sample result: 2888.89 sq ft
;;; As this is a FIELD it is updated based on the FIELDEVAL
;;; or the settings found in the OPTIONS dialog box
;;; By Jimmy Bergmark
;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; 2007-09-05 - First release
;;; 2009-08-02 - Updated to work in both modelspace and paperspace
;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD
;;; Uses TEXTSIZE for the text height
(defun Get-ObjectIDx64 (obj / util)
 (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (if (= (type obj) 'VLA-OBJECT)
   (if (> (vl-string-search "x64" (getvar "platform")) 0)
     (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
     (rtos (vla-get-objectid obj) 2 0)
   )
 )
)
(defun c:AT (/ entObject entObjectID InsertionPoint ad)
 (vl-load-com)
 (setq entObject (vlax-ename->vla-object(car (entsel)))
       entObjectID (Get-ObjectIDx64 entObject)
       InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
       ad (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (vla-addMText (if (= 1 (vla-get-activespace ad))
   (vla-get-modelspace ad)
   (if (= (vla-get-mspace ad) :vlax-true)
     (vla-get-modelspace ad)
     (vla-get-paperspace ad)
   )
 )
 InsertionPoint 0.0 (strcat
 "%<[url="file://acobjprop/"]\\AcObjProp[/url] Object(%<[url="file://_objid/"]\\_ObjId[/url] "
 entObjectID
 ">%).Area [url="file://f/"]\\f[/url] "%pr2%lu2%ct4%qf1 m²">%"
 ))
)

仍然需要你的帮助！

非常感谢。

alanjt · 发表于 2022-7-6 10:10:05

这应该有帮助。。。

我发现最简单的方法是构造一个模拟字段，然后使用vla字段代码来检索字段编码。

Peu · 发表于 2022-7-6 10:20:53

Alanjt，
非常感谢你的帮助，但我还是做不到

我在Autocad命令行上收到此消息：“选择对象：选择点：；错误：错误的参数类型：stringp nil”

我用了这个：

copy


;;; AreaText.LSP ver 3.0
;;; Command name is AT
;;; Select a polyline and where to place the text
;;; Sample result: 2888.89 sq ft
;;; As this is a FIELD it is updated based on the FIELDEVAL
;;; or the settings found in the OPTIONS dialog box
;;; By Jimmy Bergmark
;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; 2007-09-05 - First release
;;; 2009-08-02 - Updated to work in both modelspace and paperspace
;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD
;;; Uses TEXTSIZE for the text height
(defun Get-ObjectIDx64 (obj / util)
 (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (if (= (type obj) 'VLA-OBJECT)
   (if (> (vl-string-search "x64" (getvar "platform")) 0)
     (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
     (rtos (vla-get-objectid obj) 2 0)
   )
 )
)
(defun c:ATF (/ entObject entObjectID InsertionPoint ad)
 (vl-load-com)
 (setq entObject (vlax-ename->vla-object(car (entsel)))
       entObjectID (Get-ObjectIDx64 entObject)
       InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
       ad (vla-get-ActiveDocument (vlax-get-acad-object))
 )
 (vla-addMText (if (= 1 (vla-get-activespace ad))
   (vla-get-modelspace ad)
   (if (= (vla-get-mspace ad) :vlax-true)
     (vla-get-modelspace ad)
     (vla-get-paperspace ad)
   )
 )
 InsertionPoint 0.0 (strcat
 "%<\AcObjProp.16.2 Object(%<\_ObjId 8796088874016>%).Area \f "%lu2%ct4%qf1%pr2 m²%ps[A=,m²]%ct8[144]">%"
 ))
)

还有什么提示吗？=）

我也在学习！

alanjt · 发表于 2022-7-6 10:28:01

您没有正确定位引号，并且没有将对象id应用于字段。

试用：

copy

    (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
           entObjectID
           ">%).Area \\f "%lu2%pr2%ps[A=,m²]%ct8[144]">%"
   )

顺便说一句，你应该把伯格马克的头球放回去，一点也不酷。

Peu · 发表于 2022-7-6 10:36:01

安兰吉特，
我非常感激！它工作得很好！

伯格马克肯定会回来的。我刚刚删除了在论坛这里插入的网页链接需要得到版主的批准，需要一些时间才能出现。

非常感谢你！我现在会节省很多时间！=）

SLW210 · 发表于 2022-7-6 10:42:21

我把标题放回原处。如果你需要帮助，就去问裴。MOD在这里提供帮助。

[编程交流] Lisp编辑-多边形区域

发表回复

精选推荐