【Gu_xl】[原创]实用工具：Block 自动转为Lisp源代码
本帖最后由 Gu_xl 于 2016-2-25 14:14 编辑 <br /><br /><FONT style="FONT-SIZE: 10pt" id=text1 face="宋体,verdana, arial, helvetica"><BR>我们在编写AutoCAD应用程序时，经常会使用到符号库，在程序分发时必须将符号库随程序一起分发，一般符号库的图形很多，拷贝分发不是很方便，而且符号库都暴露在任何人面前。为了避免这种情况，将符号在程序中用代码生成是一种很好的办法，但是这么多符号，一句一句用代码来写，好像不太现实！<BR>好了，我这提供一个程序，能够自动将符号转成源代码，成百上千个符号，转瞬间即可全部转为lisp源代码，实现符号库的封装！<BR>请下载附件，将“图块代码生成器.VLX”添加到AutoCAD启动组里，每次AutoCAD启动时程序可自动加载！调用命令：BlockToLisp.<BR>使用方法：<BR>1、假设符号库文件存放在“c:\符号库\”目录下，打开CAD，新建图形，将符号库内DWG文件以块全部插入该图形，使用下列程序可一次性将DWG文件插入图形图形：<BR></FONT><DIV style="MARGIN-TOP: 5px; MARGIN-LEFT: 5px; MARGIN-RIGHT: 5px" 20px?="" 20px="20px" 5px?="">
<DIV style="MARGIN-BOTTOM: 2px" class=smallfont><FONT face=宋体,verdana,arial,helvetica>代码:</FONT></DIV><FONT face=宋体,verdana,arial,helvetica><PRE style="BORDER-RIGHT: 1px" class=alt2 inset?="" 1px="1px" 6px;="" 99%;="" inset;="" auto;="" 0px;="" 1px?=""><FONT style="FONT-SIZE: 10pt" face="宋体,verdana, Airal,Helvetica,Geneva">
<FONT face="courier new">
(defun c:BlockIn (/ f)
(setierr)
(foreach f (vl-sort (gxl-file-Dos_dir "c:\\符号库\\*.dwg") '<)
(command "-insert" (strcat "c:\\符号库\\" f) '(0 0 0) 1 10)
)
(reerr)
)
</FONT>
</FONT></PRE></FONT></DIV>
<DIV></DIV><BR>2、图形插入后，在命令行键入：BlockToLisp，自动生成图块文件MakeBlock.Lsp。<BR>3.、在生成的代码中定义如下函数，<BR>
<DIV style="MARGIN-TOP: 5px; MARGIN-LEFT: 5px; MARGIN-RIGHT: 5px" 20px?="" 20px="20px" 5px?="">
<DIV style="MARGIN-BOTTOM: 2px" class=smallfont><FONT face=宋体,verdana,arial,helvetica>代码:</FONT></DIV><FONT face=宋体,verdana,arial,helvetica><PRE style="BORDER-RIGHT: 1px" class=alt2 inset?="" 1px="1px" 6px;="" 99%;="" inset;="" auto;="" 0px;="" 1px?=""><FONT style="FONT-SIZE: 10pt" face="宋体,verdana, Airal,Helvetica,Geneva">
<FONT face="courier new">
;;;检查图块是否建立，如未建立图块则自动创建图块，参数：B_Name块名
(defun gxl-Blk-Check (B_Name / curlay B_Name1)
(setq B_Name1 (gxl-Str-Subst "]" ")" (gxl-Str-Subst "[" "(" B_Name)))
(setq curlay (getvar "Clayer"))
(if (not (member B_Name (GXL-TABLE "block")))
(progn
(if (or (= 'USUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))
(= 'SUBR (type (eval(read (strcat "MakeBlock-" B_Name1)))))
)
(eval (read (strcat "(MakeBlock-" B_Name1 ")"))))
)
)
(setvar "clayer" curlay)
B_Name
)
</FONT>
</FONT></PRE></FONT></DIV>
<DIV></DIV><BR>每次插入符号前调用该函数，即可实现图块的插入<BR>，如符号库中有符号名为：路灯.dwg文件，则程序自动生成的函数名为：MakeBlock-路灯 ，块名为：“l路灯”，插入路灯前调用如下函数,即可实现图块“路灯”的创建：<BR>
<DIV style="MARGIN-TOP: 5px; MARGIN-LEFT: 5px; MARGIN-RIGHT: 5px" 20px?="" 20px="20px" 5px?="">
<DIV style="MARGIN-BOTTOM: 2px" class=smallfont><FONT face=宋体,verdana,arial,helvetica>代码:</FONT></DIV><FONT face=宋体,verdana,arial,helvetica><PRE style="BORDER-RIGHT: 1px" class=alt2 inset?="" 1px="1px" 6px;="" 99%;="" inset;="" auto;="" 0px;="" 1px?=""><FONT style="FONT-SIZE: 10pt" face="宋体,verdana, Airal,Helvetica,Geneva">
<FONT face="courier new">
(gxl-Blk-Check"路灯")
</FONT>
</FONT></PRE></FONT></DIV>
<DIV></DIV><BR>说明：符号图形中实体可包括如下实体：Line/Arc/Circle/Lwpolyline/polyline/spline/Attdef/Block/solid/Hatch/Text/Mtext/Ellipse/Point,除此之外实体不能支持。Block支持嵌套！<BR>附件见5楼！ 本帖最后由 Gu_xl 于 2012-3-16 20:00 编辑
应大家的要求，现将源码公布如下，供大家共同交流：
**** Hidden Message *****代码中涉及到一些自定义公用函数，需要前贴中附件打包的函数支持！
<p dir="ltr"><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">使用程序出现下列问题是怎么回事？cad版本2008</font></p>
<p dir="ltr"><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">命令: blocktolisp<br/>; 错误: ActiveX 服务器返回错误: 无效索引。</font></p> 加载后出现此软件的使用未获得软件作者的授权呀 说QQ联系 919420899 <p>哇!不是源码啊!</p>
<p>只能纯欣赏了!</p>
<p>感谢楼主分享!</p> 我机器未装2008版，所以程序未经2008版本测试，在2000~2005有效！等我装了08版我会再调试一下！ 本帖最后由 Gu_xl 于 2013-3-14 12:33 编辑
2010年7月25日对块中含PolyLine线进行了修改 <p>Block 自动转为Lisp源代码 下载来看看学习学习</p>
<p>不知道在2006上能否用</p>
<p>谢谢楼主</p> <p>dear sir</p>
<p>plz shere sample file</p>
<p> </p> 看起来是很神奇的,明天我试试 如果能支持高版本的CAD就更好了。