到的多段线的面积和句柄

Ohnoto · 发表于 2022-7-6 08:00:45

我已经修改了一个LISP程序从线程，面积的折线。

我想做的是：

-获取单个多段线面积的平方英尺。
-获取多段线的acad句柄。

在包含许多不同属性标记的属性块内：
-将平方英尺的值放入“NET\u SQ\u FEET”的标签中
-将acad句柄值放入“acad\U句柄”的标记中

目前，从下面的代码中，我得到一个错误“VLA-OBJECT”。代码仅尝试放置平方英尺的值。我甚至不知道从哪里开始获取多段线acad句柄的值。

copy

(defun c:test ( / area en nm pt )
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel)))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (vl-catch-all-error-p
                           (setq area (vl-catch-all-apply 'vlax-curve-getarea (list en)))
                       )
                       (princ "\nInvalid Object.")
                   )
               )
               (   (setq area nil)   )
           )
       )
   )
 (setq area (rtos (/ area 144.0) 2 2))
 (if (setq block (ssget "_:S"))
(progn
 (setq block (ssname block 0))
 (LM:vl-SetAttributeValue (vlax-ename->vla-object block) "NET_SQ_FEET" area)
) 
)
 
   (princ)
)
(vl-load-com) (princ)
;;----------------=={ Set Attribute Value }==-----------------;;
;;                                                            ;;
;;  Populates the first attribute matching the tag specified  ;;
;;  found within the block supplied with the value specified, ;;
;;  if present.                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Block Reference Object                        ;;
;;  tag   - Attribute TagString                               ;;
;;  value - Value to which the Attribute will be set          ;;
;;------------------------------------------------------------;;
;;  Returns:  Value the attribute was set to, else nil        ;;
;;------------------------------------------------------------;;
(defun LM:vl-SetAttributeValue ( block tag value )
   (setq tag (strcase tag))
   (vl-some
       (function
           (lambda ( attrib )
               (if (eq tag (strcase (vla-get-TagString attrib)))
                   (progn
                       (vla-put-TextString attrib value)
                       value
                   )
               )
           )
       )
       (vlax-invoke block 'GetAttributes)
   )
)

MSasu · 发表于 2022-7-6 08:07:13

SSGET函数将返回选择集，而不是实体；下面的代码将验证用户是否选择了某个项目，并从选择集中提取第一个（也是唯一一个）项目。此外，似乎Lee的代码需要一个VLA对象。
要列出实体，请检查ENTGET函数：
手柄存储在DXF代码5上。

Ohnoto · 发表于 2022-7-6 08:09:11

谢谢我更新了原始代码。我会查一下把手放在哪里。

MSasu · 发表于 2022-7-6 08:11:56

最好使用过滤器进行选择。
1.这将阻止用户选择闭合多段线，而不是ENTSEL：

copy

(if (setq en (ssget "_:S" '((0 . "LWPOLYLINE") (70 . 1)))[color=red])[/color]
(setq en (ssname en 0))
)

2。对于块：

copy

(setq block (ssget "_:S" '((0 . "INSERT"))))

Ohnoto · 发表于 2022-7-6 08:16:58

在输入您提供的第一个代码时，我得到的参数错误太少。你能演示一下应该如何放置吗？

MSasu · 发表于 2022-7-6 08:19:18

你是对的，我错过了一个偏执-请检查固定的代码。很抱歉给您带来不便。

Ohnoto · 发表于 2022-7-6 08:21:51

在选择多段线时，将其放置在ENTSEL所在的位置会出现“错误的参数类型：consp”错误。

MSasu · 发表于 2022-7-6 08:26:15

你能贴出你是如何修改那个部分的吗？

Ohnoto · 发表于 2022-7-6 08:29:18

copy

(defun c:test ( / area en nm pt )
   (while
       (progn (setvar 'ERRNO 0) (setq en (car
                       (if (setq en (ssget "_:S" '((0 . "LWPOLYLINE") (70 . 1))))
                         (setq en (ssname en 0))
                         )))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (vl-catch-all-error-p
                           (setq area (vl-catch-all-apply 'vlax-curve-getarea (list en)))
                       )
                       (princ "\nInvalid Object.")
                   )
               )
               (   (setq area nil)   )
           )
       )
   )

MSasu · 发表于 2022-7-6 08:31:37

这是您应该如何更改该部分：
你可以写得很简单：

copy

(defun c:test ( / area en nm pt)
(if (setq en (ssget "_:S" '((0 . "LWPOLYLINE") (70 . 1))))
 (if (vl-catch-all-error-p
      (setq area (vl-catch-all-apply 'vlax-curve-getarea (list (ssname en 0))))
     )
  (princ "\nInvalid Object.")
 )
 )
(setq area (rtos (/ area 144.0) 2 2))
[color=magenta]...[/color]

[编程交流] 到的多段线的面积和句柄

发表回复

精选推荐