【转帖】上传一个简单实用的lisp源程序（图元快速成块）：
 

上传一个简单实用的lisp源程序（图元快速成块）：
www.dimcax.com
上传一个简单实用的lisp源程序（图元快速成块）：
;;designed by g.q.lou 12-26-2008
(defun c:qblock(/ a b c d e f val val1) ;主函数开始
(setq val(getvar "cmdecho")) ;获系统变量“是否回显”参数
(setvar "cmdecho" 0) ;设command 函数运行期间，autocad 不回显提示和输入
(defun *error* (msg) ;按esc键时的处理方法
(setvar "gripsize" val1) ;按esc键时把夹点恢复原来大小
(princ"")
;(princ msg)
;(princ)
)
(setq a(cadr(ssgetfirst)));判断当前图形是否有既被夹取的对象,如果有则把这个选择集赋予变量a
(if(= a nil) ;如果变量a为空时
(progn
(setq val1(getvar "gripsize")) ;获得系统夹点大小
(print "-> 请选择要设为块的对象或按<esc>退出") ;显状态栏提示的信息
(setq b(ssget));创建一个选择集
(initget 1) ;为随后的交互输入函数getpoint创关键字
(setq c(getpoint"\n指定基点:"));获得一个三维点坐标
;(setq d(list (car c) (cadr c)));转换为二维点坐标(在此不必要)
(command "undo" "group") ;为undo编组
(command "copybase" c b "");调用autocad的copybase命令
(command "erase" b "");调用autocad的erase命令删除b选择集
(command "pasteblock" c);调用autocad的pasteblock命令
(command "undo" "end") ;undo编组结束
(prompt "\n***** 对象设为块成功! *****") ;显状态栏提示的信息
)
(progn ;如果变量a不为空时
(setq val1(getvar "gripsize")) ;获得系统夹点大小
(setvar "gripsize" 1) ;设夹点大小
(print "-> 所选对象将设为块或按<esc>退出:") ;显状态栏提示的信息
(initget 1) ;为随后的交互输入函数getpoint创关键字
(setq c(getpoint"\n指定基点:"));获得一个三维点坐标
(setvar "gripsize" val1) ;把夹点恢复原来大小
;(setq d(list (car c) (cadr c)));转换为二维点坐标(在此不必要)
(command "undo" "group") ;为undo编组
(command "copybase" c a "");调用autocad的copybase命令
(command "erase" a "");调用autocad的erase命令删除b选择集
(command "pasteblock" c);调用autocad的pasteblock命令
(command "undo" "end") ;undo编组结束
(prompt "\n***** 对象设为块成功! *****") ;显状态栏提示的信息
)
);if结束
(princ);静默退出
(setvar "cmdecho" val) ;设command 函数运行期间，autocad 的回显提示和输入恢复原状
);主函数结束
;;;--------------------------------end----------------------------------------

支持

程序用起来很好,是否能将所作的块起一个块名,并赋予以一个基点是否更好

程序很不错,不过还要进一步改进.

楼主能不能发一个程序，代码还要编写，费时