社区 › Auto Lisp › 多个Poi上的多个块

symoin 发表于 2022-7-6 07:21:52

多个Poi上的多个块

海专家，
 
如果我们有一个图形，其点超过1层（例如10层或20层，每层50个点），我们需要在一个层的每个点上放置一个块，并诸如此类。如果我们知道块与层具有相同的名称。
例如，层=树&块=树，层=棕榈&块=棕榈，层=杆&块=杆，层=垃圾箱&块=垃圾箱等等。
 
是否有任何lisp，我们可以通过它将不同的块放置在不同的层上，所有这些都在一个选择的窗口中。
 
当做

Lee Mac 发表于 2022-7-6 07:37:59

试一试：
 

(defun c:test ( / acdoc acsel acspc blk lay lst )

   (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
         acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
   )
   (cond
       (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
         (princ "\nCurrent Layer Locked.")
       )
       (   (ssget '((0 . "POINT")))
         (vlax-for obj (setq acsel (vla-get-activeselectionset acdoc))
               (if
                   (or
                     (and
                           (member (setq lay (vla-get-layer obj)) lst)
                           (setq blk lay)
                     )
                     (and
                           (tblsearch "BLOCK" lay)
                           (setq lst (cons lay lst)
                                 blk lay
                           )
                     )
                     (setq blk (findfile (strcat lay ".dwg")))
                   )
                   (vla-put-layer (vla-insertblock acspc (vla-get-coordinates obj) blk 1.0 1.0 1.0 0.0) lay)
               )
         )
         (vla-delete acsel)
       )
   )
   (princ)
)
(vl-load-com) (princ)

David Bethel 发表于 2022-7-6 07:43:59

完全未经测试：
 
 

(defun c:test (/ dl td ln bn ss en ed i)

;;;DEFINE THE DELIMITER
(setq dl " & ")

;;;SETP THROUGH THE LAYER TABLE
(while (setq td (tblnext "LAYER" (not td)))
      (and (setq ln (cdr (assoc 2 td)))
             (wcmatch ln (strcat "*" dl "*"))
             (setq i 1)
             (while (/= (substr ln i (strlen dl)))
                  (setq i (1+ i)))
             (setq bn (substr ln 1 (1- i)))
             (or (findfile (strcat bn ".dwg"))
               (tblsearch "BLOCK" bn))
             (setq ss (ssget "X" (list (cons 0 "POINT")(cons 8 ln))))
             (not (ssget "X" (list (cons 0 "INSERT")
                                 (cons 2 bn)
                                 (cons 8 ln))))
             (while (setq en (ssname ss 0))
                  (setq ed (entget en))
                  (if (not (tblsearch "BLOCK" bn))
                        (progn (command "_.INSERT" bn)
                               (command)))
                  (entmake (list (cons 0 "INSERT")
                                 (cons 2 bn)
                                 (assoc 8 ed)
                                 (assoc 10 ed)))
                  (ssdel en ss))))
(prin1))

 
 
-大卫

symoin 发表于 2022-7-6 07:50:06

感谢李的出色工作，
 
谢谢david，但我还没有试过你的代码，
 
迎合双方的努力，
 
当做

Lee Mac 发表于 2022-7-6 08:02:59

不客气，西莫。

symoin 发表于 2022-7-6 08:11:14

李海，
再次需要您的帮助，现在图形中的块名为sp，而不是point。在本例中，我尝试将代码（ssget’（（0。“POINT”））更改为（ssget’（（0。“insert”））
选择对象：；错误：ActiveX服务器返回错误：未知名称：坐标
 
和（ssget’（（0。“block”））它显示了messege命令：TEST
选择对象：指定对角点：0
选择对象：*取消*
; 错误：功能已取消
 
你的帮助太过分了。

Lee Mac 发表于 2022-7-6 08:14:30

块参照没有坐标特性，而是使用InsertionPoint特性来存储其插入点的坐标，因此代码变为：
 

(defun c:test ( / acdoc acsel acspc blk lay lst )

   (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
         acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
   )
   (cond
       (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
         (princ "\nCurrent Layer Locked.")
       )
       (   (ssget '((0 . "INSERT") (2 . "SP")))
         (vlax-for obj (setq acsel (vla-get-activeselectionset acdoc))
               (if
                   (or
                     (and
                           (member (setq lay (vla-get-layer obj)) lst)
                           (setq blk lay)
                     )
                     (and
                           (tblsearch "BLOCK" lay)
                           (setq lst (cons lay lst)
                                 blk lay
                           )
                     )
                     (setq blk (findfile (strcat lay ".dwg")))
                   )
                   (vla-put-layer (vla-insertblock acspc (vla-get-insertionpoint obj) blk 1.0 1.0 1.0 0.0) lay)
               )
         )
         (vla-delete acsel)
       )
   )
   (princ)
)
(vl-load-com) (princ)
[未测试，假设块“SP”不是动态的]

symoin 发表于 2022-7-6 08:22:42

谢谢李，
 
以便立即响应。块sp不是动态的。
 
再次感谢。

查看完整版本: 多个Poi上的多个块