所选物体归到0层颜色随块在做块怎么写？
(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)
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 9701519的微博 (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)
) caoyin 发表于 2012-3-16 18:04 static/image/common/back.gif
(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 无名块 **） (setq BLK (vla-add BLKS PT "*U"))楼主可自己改成以时间命名的块
明白了！
越来越多人用动态块，copyobjects这类代码少用，处理不了动态块 感谢作者的分享！
页:
[1]