块到层

Baber62 · 发表于 2022-7-6 00:03:18

有人能帮忙吗。。。绘制一个包含多个块的图形，所有块都位于零层。

我需要一个lisp例程，使他们成为基于邮政编码的个人层（见附图）。

BlackBox · 发表于 2022-7-6 00:16:40

你能寄一张样图吗？

Baber62 · 发表于 2022-7-6 00:16:46

没有问题。见附件。这只是我正在处理的文件的一个样本。
Southwark邮编。图纸

CheSyn · 发表于 2022-7-6 00:23:52

已测试，并在您发布的示例图形中工作。如果你遇到任何问题，请告诉我。

copy


;;;
;;; CheSyn 2013
;;; BLK2LAYER - change layer of block to tag value
;;;
(defun c:blk2layer ( / oe ss no e x at ax ln)
   (command "_.undo" "BEgin")
 (setq oe (getvar 'CMDEcho) )
 (setvar 'CMDEcho 0)
   (setq ss (ssget "_x" '( (0 . "INSERT")(2 . "BLK*")(8 . "0") ))
         no 0 )
   (while
       (< no (sslength ss) )
       (setq e (ssname ss no)
             x (entget e)
             at (entnext e)
             ax (entget at) )
           (while
               (/= "SEQEND" (cdr (assoc 0 ax)) )
               (if
                   (= "Postcode" (cdr (assoc 2 ax)) )
                   (setq ln (cdr (assoc 1 ax)) )
               )
               (setq at (entnext at)
                     ax (entget at) )
           )
               (entmod
                   (subst
                       (cons 8 ln)
                       (assoc 8 x)
                       x
                   )
               )
           (entupd e)
       (setq no (1+ no) )
   )
 (setvar 'CMDEcho oe)
   (command "_.undo" "End")
 (princ)
)

Baber62 · 发表于 2022-7-6 00:36:10

谢谢，效果很好，谢谢。

pBe · 发表于 2022-7-6 00:39:29

编写代码的另一种方法

copy

(defun c:b2l (/ ss i lay e et enx)
 (if (setq ss (ssget "_X"
              '((0 . "INSERT") (66 . 1))
       )
     )
   (repeat (setq i (sslength ss))
     (setq lay nil e  (ssname ss (Setq i (1- i)))
    l  (assoc -1 (entget e))
    et e
     )
     (while
(and
  (null lay)
  (= (cdr (assoc 0 (setq enx (entget (setq et (entnext et))))))
     "ATTRIB"
  )
)
 (if (= "POSTCODDE" (strcase (cdr (assoc 2 enx))))
   (setq lay (cdr (assoc 1 enx)))
 )
     )
     [color="blue"](if lay [/color](entmod (list (cons 8 lay) l))[color="blue"])[/color]
   )
 )
 (princ)
)