面积/介电常数脚本文件乐筑天下 - Powered by Discuz! Archiver

s8utt 发表于 2022-7-6 07:07:34

您好，谢谢您的帮助。

我做错什么了吗？我创建了文件，打开它，它成功地创建了文本。然而，它给出的不是数字####

我还需要表演什么吗？

另外（使用GetAP脚本）为什么该区域是普通文本，而#####具有灰色背景？

非常感谢你的帮助

s8utt 发表于 2022-7-6 07:12:11

使现代化

查看######，如果我双击它，它会打开“字段”对话框，并显示“未知”。

字段表达式显示为

%%).区域\f“%lu2”>%

如果我手动单击字段名称：object>property area，字段表达式显示为

%%).区域\f“%lu2”>%

看起来对象id不同？

Lee Mac 发表于 2022-7-6 07:15:53

使用我的GetAP函数，一切似乎都很好。

我不知道你为什么会得到一个错误的ObjectID

灰色背景表示文本是一个字段。

Lee Mac 发表于 2022-7-6 07:17:58

艾伦，我的功能对你合适吗？

s8utt 发表于 2022-7-6 07:19:48

如果我稍微把你的代码改成这个

      (strcat "Area:(%<\\_ObjId " (car Ids) ">%) %<\\AcObjProp Object(%<\\_ObjId
            8796087810544>%).Area \\f \"%lu6%qf1\">%"
            "\\PPerimeter: %<\\AcObjProp Object(%<\\_ObjId "
            (car Ids) ">%).Length \\f \"%lu6\">%")

所以我在区域字符串中添加了objectid
我已经硬编码了我当前的objectid

我明白了

Area:(42) 57390.52

因此，对objectid进行硬编码是可行的，因此这一部分很好。
对我来说奇怪的是，每次运行autocad时对象id都会更改，对吗？因此，我的对象id已从上面的更改。

但是42没有改变？？

我是否可以运行一个非常简单的命令来返回所选objectd的objectid，因为我认为这就是问题所在。

谢谢

s8utt 发表于 2022-7-6 07:24:20

哦，我只是想，也许问题是

使用windows 7 64位
autocad 2009 64位

?

s8utt 发表于 2022-7-6 07:26:22

更新，这肯定是由于64位autocad引起的问题。

找到此代码段

;; function to get the ID string from a object
; (Get-ObjectIDx64 (car (entsel)))
(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)
)
)
)

这将返回正确的objectid，现在将其实现到代码中。
有什么建议吗？

Lee Mac 发表于 2022-7-6 07:29:42

哇，我不知道有这么大的不同。。。无论如何，这是我的更新代码：

(defun c:GetAP (/ *error* lst->str DOC IDS PT SS UFLAG UTIL)
(vl-load-com)
;; Lee Mac~18.03.10

(defun *error* (msg)
(and uFlag (vla-EndUndomark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   (princ (strcat "\n** Error: " msg " **")))
(princ))

(defun lst->str (lst d1 d2)
(if (cdr lst)
(strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
(strcat d1 (car lst))))

(defun GetObjectID (obj)
(setq util (cond (util) ((vla-get-Utility
                           (vla-get-ActiveDocument (vlax-get-acad-object))))))

(if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
(vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))))

(princ "\nSelect Objects to Retrieve Total Area + Perimeter...")
(if (and (ssget '((0 . "ARC,CIRCLE,ELLIPE,HATCH,*POLYLINE,REGION")))
      (setq pt (getpoint "\nPick Point for Field: ")))
(progn
(setq uFlag (not (vla-StartUndoMark
                     (setq doc (vla-get-ActiveDocument
                                 (vlax-get-acad-object))))))

(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
   (setq Ids (cons (GetObjectID Obj) Ids)))
(vla-delete ss)

(vla-AddMText

   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
            (eq :vlax-true (vla-get-MSpace doc)))
      (vla-get-ModelSpace doc)
      (vla-get-PaperSpace doc))

   (vlax-3D-point pt) 0.

   (if (= 1 (length Ids))
      (strcat "Area: %<\\AcObjProp Object(%<\\_ObjId "
            (car Ids) ">%).Area \\f \"%lu6%qf1\">%"
            "\\PPerimeter: %<\\AcObjProp Object(%<\\_ObjId "
            (car Ids) ">%).Length \\f \"%lu6\">%")

      (strcat "Area: %<\\AcExpr"
            (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Area >% +")
            ">%).Area >% \\f \"%lu6%qf1\">%"
            "\\PPerimeter: %<\\AcExpr"
            (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Length >% +")
            ">%).Length >% \\f \"%lu6\">%")))

(setq uFlag (vla-EndUndomark doc))))

(princ))

stevesfr 发表于 2022-7-6 07:33:30

好吧，我的朋友，除非我设置了一些wierd，否则它不会给出圆形区域的周长（cir）？
S

Lee Mac 发表于 2022-7-6 07:36:29

哦，是的，我添加了周长输出，但应该从选择集中删除圆等：

(defun c:GetAP (/ *error* lst->str DOC IDS PT SS UFLAG UTIL)
(vl-load-com)
;; Lee Mac~18.03.10

(defun *error* (msg)
(and uFlag (vla-EndUndomark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   (princ (strcat "\n** Error: " msg " **")))
(princ))

(defun lst->str (lst d1 d2)
(if (cdr lst)
(strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
(strcat d1 (car lst))))

(defun GetObjectID (obj)
(setq util (cond (util) ((vla-get-Utility
                           (vla-get-ActiveDocument (vlax-get-acad-object))))))

(if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
(vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))))

(princ "\nSelect Objects to Retrieve Total Area + Perimeter...")
(if (and (ssget '((0 . "LINE,*POLYLINE")))
      (setq pt (getpoint "\nPick Point for Field: ")))
(progn
(setq uFlag (not (vla-StartUndoMark
                     (setq doc (vla-get-ActiveDocument
                                 (vlax-get-acad-object))))))

(vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
   (setq Ids (cons (GetObjectID Obj) Ids)))
(vla-delete ss)

(vla-AddMText

   (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
            (eq :vlax-true (vla-get-MSpace doc)))
      (vla-get-ModelSpace doc)
      (vla-get-PaperSpace doc))

   (vlax-3D-point pt) 0.

   (if (= 1 (length Ids))
      (strcat "Area: %<\\AcObjProp Object(%<\\_ObjId "
            (car Ids) ">%).Area \\f \"%lu6%qf1\">%"
            "\\PPerimeter: %<\\AcObjProp Object(%<\\_ObjId "
            (car Ids) ">%).Length \\f \"%lu6\">%")

      (strcat "Area: %<\\AcExpr"
            (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Area >% +")
            ">%).Area >% \\f \"%lu6%qf1\">%"
            "\\PPerimeter: %<\\AcExpr"
            (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Length >% +")
            ">%).Length >% \\f \"%lu6\">%")))

(setq uFlag (vla-EndUndomark doc))))

(princ))

页: 1 [2]

乐筑天下's Archiver