用于标记图案填充对象的Lisp 乐筑天下

mhmtlgrr 发表于 2022-7-5 16:10:40

用于标记图案填充对象的Lisp

亲爱的各位，

我们都知道Revit具有标记功能，我知道AutoCAD也可以使用Lisp实现这一点。

假设我们在不同的层中有5个不同的实体图案填充，如：
层名称-L1
层名称-L2
图层名称-L3
图层名称-L4
层名称-L5

我想放置一个名为LNAME的块和一个属性，将它们放置在图案填充上，并在其中获得对象->层比例。

我附上了样本文件。

提前感谢。

文科硕士
LISP标记。图纸

BIGAL 发表于 2022-7-5 16:16:26

时间不够了，试试这个

(setvar "attdia" 0)
(while (setq obj (vlax-ename->vla-object (car (entsel "\nPick hatch"))))
(setq lay (vla-get-layer obj))
(command "-Insert" "lname" (getpoint) 1000 0.0 lay)
)

Grrr 发表于 2022-7-5 16:21:58

(defun C:test ( / spc SS attr i o p ll ur )
(vl-every 'eval
'(
(setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
(princ "\nSelect hatches to insert \"LNAME\" block on their centroids.")
(setq SS (ssget '((0 . "HATCH")(2 . "SOLID")(8 . "L1,L2,L3,L4,L5"))))
(setq attr (getvar 'attreq)) (setvar 'attreq 0)
(progn
   (repeat (setq i (sslength SS))
      (vla-GetBoundingBox (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) 'll 'ur)
      (setq p (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur))))) ; LM
      (vla-put-Layer (vlax-invoke spc 'InsertBlock p "LNAME" 1.0 1.0 1.0 0.0) (vla-get-Layer o))
   )
   (setvar 'attreq attr)
)
)
)
(princ)
) (vl-load-com) (princ)

mhmtlgrr 发表于 2022-7-5 16:32:12

尊敬的Grrr：，

谢谢你的回复。您的代码将标记像一个符咒一样放置在图案填充对象质心上！但是，我有两个问题：

1、只考虑实体图案填充。我假设您有意将选择范围锁定为实心范围，但图形中甚至可能存在自定义填充图案。附件上的一个用于演示。
2.标签不具有层名称属性。它们都会一直显示“Lx”，这是属性的默认值。
3.我认为可能的层名称在代码中定义为：（setq SS（ssget’（（0。“HATCH”）（2。“SOLID”）（8。“L1，L2，L3，L4，L5”））
但它们会随着文件的不同而变化，就像填充图案名称一样。

请参阅附件。

提前感谢。

文科硕士
LISP-TAGGING_V2。图纸

BIGAL 发表于 2022-7-5 16:34:11

获取一组图案填充（0。“图案填充”）的选择集，图案为实心（2。“实心”），位于任何层L1、L2、L3、L4、L5（8。“L1、L2、L3、L4、L5”）

获取图案填充的选择集（setq SS（ssget’（（0。“HATCH”）））

关于质心的Grr很好。

mhmtlgrr 发表于 2022-7-5 16:40:53

尊敬的Bigal：，

谢谢你的解释。我们可以将其设置为：

获得一组图案填充选择集（0。“图案填充”），具有任何图案（2。“实体”）和任何层（8。“L1、L2、L3、L4、L5”）

Grrr 发表于 2022-7-5 16:43:41

谢谢，不过这篇文章是由李提供的。
所以我总是在同一行加上他的首字母。

您有两种选择：
a、删除组码（2。“实心”）和（8。“L1、L2、L3、L4、L5”）
b、使用：（2“*”）和（8“*”）

好的，现在我看到您使用了名为“LNAME”的属性块，它的属性带有标记“LNAME”

(defun C:test ( / spc SS attr i o p ll ur b lyr )
(vl-every 'eval
'(
(setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
(princ "\nSelect hatches to insert \"LNAME\" block on their centroids.")
(setq SS (ssget '((0 . "HATCH"))))
(setq attr (getvar 'attreq)) (setvar 'attreq 0)
(progn
   (repeat (setq i (sslength SS))
      (vla-GetBoundingBox (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) 'll 'ur)
      (setq p (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur))))) ; LM
      (vla-put-Layer (setq b (vlax-invoke spc 'InsertBlock p "LNAME" 1.0 1.0 1.0 0.0)) (setq lyr (vla-get-Layer o)))
      (vl-some
      '(lambda (x)
         (cond
            ( (not (vlax-write-enabled-p x)) nil)
            ( (= "LNAME" (strcase (vla-get-TagString x))) (vla-put-TextString x (vla-get-Layer o)) T)
         )
      )
      (vlax-invoke b 'GetAttributes)
      )
   )
   (setvar 'attreq attr)
)
)
)
(princ)
) (vl-load-com) (princ)

Tharwat 发表于 2022-7-5 16:53:17

你好

这是我对Field object的尝试。

(defun c:taghatches (/ getid doc lst blk int hat sel ent q p)
;;------------------------------------;;
;; Tharwat - Date: 26.07.2017 ;;
;; Tag hatches with Attributed Block ;;
;; that entitled: LNAME then add the ;;
;; Hatch layer into the previous said ;;
;; Att.Block as a field object in Att.;;
;;------------------------------------;;
(if (and (or (and (setq blk (tblsearch "BLOCK" "LNAME"))
               (= (cdr (assoc 70 blk)) 2)
               )
         (alert"Block Name <LNAME> is either not found in drawing or it's not attributed block <!>")
         )
      (princ "\nSelect hatches :")
      (setq int -1
            doc (vla-get-activedocument (vlax-get-acad-object))
            sel (ssget "_:L" '((0 . "HATCH")))
            )

)
(progn
   (defun getid (obj doc / u)
   (if (vlax-method-applicable-p (setq u (vla-get-utility doc)) 'getobjectidstring)
      (vla-getobjectidstring u obj :vlax-false)
      (itoa (vla-get-objectid obj))
   )
   )
   (while (setq ent (ssname sel (setq int (1+ int))))
   (vla-getboundingbox (setq hat (vlax-ename->vla-object ent)) 'q 'p)
   (and
      (setq lst (mapcar 'vlax-safearray->list (list q p))
            blk (vlax-invoke
                  (vla-get-block (vla-get-activelayout doc))
                  'insertblock
                  (mapcar '(lambda (j k) (* (+ j k) 0.5)) (car lst) (cadr lst))
                  "LNAME"
                  1.0
                  1.0
                  1.0
                  0.0
               )
      )
      (vl-some '(lambda (att)
                  (and (= (strcase (vla-get-tagstring att)) "LNAME")
                        (progn
                        (vla-put-textstring att (strcat "%<\\AcObjProp Object(%<\\_ObjId " (getid hat doc) ">%).Layer>%")) t)
                  )
               )
               (vlax-invoke blk 'getattributes)
      )
   )
   )
   (and doc (vla-regen doc acactiveviewport))
)
)
(princ)
) (vl-load-com)

mhmtlgrr 发表于 2022-7-5 16:58:13

塔瓦，你又来了！

谢谢你们！两者都在工作，但Tharwat的代码将块放置在当前层上，因为我们需要将它们放置在标记层上。

最后一个问题：

代码将标记放置在质心上。因此，当我试图标记一个L形物体时，标记会放置在附件上显示的空白处。
是否可以将标记放置在填充图案的某个位置？

提前谢谢。

文科硕士
LISP-TAGGING_V3。图纸

Tharwat 发表于 2022-7-5 17:01:09

你好

实际上，代码没有将属性块LNAME放置在中心点，而是位于左下角和右上角点之间的边界框的中心点。

回到您关于更改属性块位置的请求，那么它是否总是应该放置在左上角，如上次上载的图形所示？
它是否总是具有相同的偏移距离？

页: [1] 2

乐筑天下's Archiver

用于标记图案填充对象的Lisp