[编程申请]：将所有块定议0层,并且块的属性随层

my_autocad

将所有块定议0层,并且块的属性随层
一个文件有很多块没有规范定议,没有在0层上,而且属性不随层,
如果有一个程序能将这些图块迅速地改在0层上定议就好了

xyp1964

全部块改到0层：
[php](defun c:test()
  (setq ss (ssget"X" '((0 . "INSERT"))))
  (command "change" ss "" "p" "la" "0" "")
  )[/php]

my_autocad

下了,试了,错了
我想把那样没有在0层上的图块定议在0层,属性随层,改后的图块仍然是在他们被安排的层上,

你的程序只能实现将所有的块全部置于0层,没有达到以上的目的,

设计好的程序应该方便修改没有规范的图块.
谢谢你的热心

xshrimp

参见
[php]
;;
;FIXBLOCK.LSP  
;
; Load function, then enter FIXBLOCK to redefine selected blocks
;  so that all entities are on layer '0'.
;
(defun fixblk (/ ss cnt b donelist bredef)
  (defun bredef (b / e el)
    (setq e (tblobjname "BLOCK" b))
    (while e
      (setq el (entget e))
      (setq el (subst '(8 . "0") (assoc 8 el) el))
      (setq el (if (assoc 62 el) (subst '(62 . 256) (assoc 62 el) el) (append el '((62 . 256)))))
      (entmake el)
      (setq e (entnext e))
    )
    (if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 256))))
  )
  (if (> (logand (cdr (assoc 70 (tblsearch "layer" "0"))) 1) 0)
    (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
    (if (setq ss (ssget '((0 . "INSERT"))))
      (progn
        (setq cnt (sslength ss))
        (while (>= (setq cnt (1- cnt)) 0)
          (if (not (member (setq b  (cdr (assoc 2 (entget (ssname ss cnt))))) donelist))
            (progn
              (bredef b)
              (setq donelist (cons b donelist))
            )
          )
        )
        (princ (strcat "\n" (itoa (sslength ss)) " blocks redefined\n"))
      )
      (princ "\nNo blocks selected!\n")
    )
  )
  (command "regen")
  (princ)
)
[/php]