所选物体归到0层颜色随块在做块怎么写？

9701519

(defun c:bm (/ ss os cmdecho)
;;物体归到0层颜色随块程序
  (setq se1(ssget))
  (command "change" "si" se1 "p" "c" bylayer "")
;;写块程序
  (setq os (getvar 'osmode))
  (setq cmdecho (getvar 'cmdecho))
  (setvar 'osmode 0)
  (setvar 'cmdecho 0)
  (princ "\n选择要做块实体:")
  (while (setq ss (ssget))
    ;;时间为块名
    (setq name (rtos (getvar 'cdate) 2 8))
    (command "block" name  "0,0,0" ss "")
    (command "insert" name "0,0,0" 1 1 0)
    (princ "\n回车结束<继续做块>:")
    )
    (setvar 'osmode os)
  (setvar 'cmdecho cmdecho)
(princ)
  )



该贴已经同步到 9701519的微博

caoyin

(defun C:TT (/ SS PT DOC BLKS I OBJ LST)
  (if (and (setq SS (ssget))
           (setq PT (getpoint "\n指定插入点: "))
      )
    (progn
      (setq DOC  (vla-get-ActiveDocument (vlax-get-acad-object))
            BLKS (vla-get-blocks DOC)
            PT   (vlax-3d-point (trans PT 1 0))
      )
      (repeat (setq I (sslength SS))
        (setq I   (1- I)
              OBJ (vlax-ename->vla-object (ssname SS I))
              LST (cons OBJ LST)
        )
        (vla-put-layer OBJ "0")
        (vla-put-color OBJ "0")
      )
      (vlax-invoke DOC
                  'CopyObjects
                  LST
                  (setq BLK (vla-add BLKS PT "*U"))
      )
      (vla-InsertBlock
        (if (= (getvar 'cvport) 1)
          (vla-get-PaperSpace DOC)
          (vla-get-ModelSpace DOC)
        )
        PT (vla-get-name BLK) 1 1 1 0
      )
      (mapcar 'vla-delete LST)
    )
  )
  (princ)
)

9701519

caoyin 发表于 2012-3-16 18:04
(defun C:TT (/ SS PT DOC BLKS I OBJ LST)
  (if (and (setq SS (ssget))
           (setq PT (getpoin ...

用此命令做出块没法修改！（refedit 选择参照: 180.653483,55.783716,0.000000
** 无法 REFEDIT 无名块 **）

caoyin

(setq BLK (vla-add BLKS PT "*U"))楼主可自己改成以时间命名的块

9701519

明白了！

kozmosovia

越来越多人用动态块，copyobjects这类代码少用，处理不了动态块

tensir

感谢作者的分享！