社区 › Auto Lisp › 带面积字段的多边形

Grrr 发表于 2022-7-5 18:22:06

带面积字段的多边形

大家好，
我正在寻找一个lisp例程，它创建边界样条线并插入引用该样条线的面积字段。

Tharwat 发表于 2022-7-5 18:39:45

玩一玩这个节目，让我知道。
 

(defun c:test (/ doc e o u spc reg obj mt p)
;;    Tharwat 19.11.2015    ;;;
(setq e (entlast))
(if (and (vl-cmdf "_.-boundary" "\\" "\\")
          (setq o (entlast))
          (not (eq e o))
          (eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
   )
   (progn
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         spc (vla-get-block
               (vla-item (vla-get-layouts doc) (getvar 'ctab))
               )
         reg (vlax-invoke
               spc
               'addregion
               (list (setq obj (vlax-ename->vla-object o)))
               )
   )

   (if (setq
         p(vlax-3d-point
                (append (vlax-get (car reg) 'centroid) (list 0.))
            )
         mt (vla-addmtext
                spc
                p
                0.0
                (strcat
                  "%<\\AcObjProp Object(%<\\_ObjId "
                  (if (vlax-method-applicable-p
                        (setq
                        u (vla-get-utility
                              doc
                            )
                        )
                        'getobjectidstring
                      )
                  (vla-getobjectidstring u obj :vlax-false)
                  (itoa (vla-get-objectid obj))
                  )
                  ">%).Area \\f \"%lu6%qf1\">%"
                )
            )
         )
       (progn
         (vla-put-attachmentpoint mt acmiddlecenter)
         (vla-move mt (vla-get-insertionpoint mt) p)
       )
   )
   (vla-delete (car reg))
   )
)
(princ)
)
(vl-load-com)

Grrr 发表于 2022-7-5 18:57:45

工作完美！
只是一个小小的请求：你能将字段的对齐设置为“中间居中”吗？
非常感谢。

Tharwat 发表于 2022-7-5 19:02:08

不客气。
 
当然有可能，以上代码已更新。

Grrr 发表于 2022-7-5 19:13:47

再次感谢你，我觉得这个lisp非常有用！

Tharwat 发表于 2022-7-5 19:25:33

不客气，我刚刚加入了我的工具箱。

查看完整版本: 带面积字段的多边形