[原创]对象均布与对齐工具

mccad

注意，该程序不做公开，如有需要，可来信索取部分原码。

下载文件后，将文件放到启动组中，直接使用以下命令即可调用：
AO：对齐对象
EO：均布对象

该程序为测试版本，希望大家测试后提点意见，以便完善。

========================================================
2004-11-21：
该文件已经更新为正式版本，更新如下：
1.支持简体、繁体及英文三种语言。
2.实现对齐的方式记忆功能。

命令运行：
"AlignEntity"或 "ALE"：对齐对象
"AverageEntity" "AVE" ：均布对象
========================================================
先选择后操作需要将以下内容写入acad200xdoc.lsp 文件中：

2. (vl-load-com)
   
3. ;;自动加载VBA程序的函数
   
4. ;;本函数由明经通道mccad开发，版权所有，复制使用时请保留版权信息
   
5. (defun AutoVBALoad (app cmdliste / qapp )
   
6.    (setq qapp (strcat """ app """))
   
7.    (mapcar
   
8.        '(lambda (cmd / nom_cmd dot nodotcmd)
   
9.              (progn
   
10.    (setq dot (vl-string-search "." cmd))
    
11.    (if   dot
    
12.        (setq nodotcmd (substr cmd (+ dot 2)))
    
13.        (setq nodotcmd cmd)
    
14.    )
    
15.    (setq nom_cmd (strcat "C:" nodotcmd))
    
16.    (eval
    
17.            (read (strcat
    
18.              "(defun " nom_cmd "( / rtn)"
    
19.                  "(if (setq app(fdvbfile " qapp "))"
    
20.                      "(vl-vbarun (strcat app "!" cmd ""))"
    
21.                      "(nodvbfile " qapp "))"
    
22.              "(princ))"
    
23.            )
    
24.            )
    
25.    )
    
26.              )
    
27.          )
    
28.        cmdliste
    
29.    )
    
30.    nil
    
31. )
    
32. 
    
33. (defun fdvbfile  (app)
    
34.    (if (not (findfile app))
    
35.        (if (not (findfile (strcat app ".dvb")))
    
36.            nil
    
37.            (strcat app ".dvb")
    
38.        )
    
39.        app
    
40.    )
    
41. )
    
42.       
    
43. (defun nodvbfile (filename)
    
44.    (princ (strcat "\n文件 " filename
    
45.          "(.dvb) 在搜索路径文件夹中未找到。" ) )
    
46.    (princ "\n请检查支持文件的安装，然后重试。")
    
47.    (princ)
    
48. )
    
49. (AutoVbaLoad "AlignEntity" '("AlignEntity" "AverageEntity" "AVE" "ALE"))
    

(vl-load-com)<br /> ;;自动加载VBA程序的函数 <br /> ;;本函数由明经通道mccad开发，版权所有，复制使用时请保留版权信息<br /> (defun AutoVBALoad (app cmdliste / qapp )<br />    (setq qapp (strcat """ app """))<br />    (mapcar<br />        '(lambda (cmd / nom_cmd dot nodotcmd)<br />              (progn<br />    (setq dot (vl-string-search "." cmd))<br />    (if   dot<br />        (setq nodotcmd (substr cmd (+ dot 2)))<br />        (setq nodotcmd cmd)<br />    )<br />    (setq nom_cmd (strcat "C:" nodotcmd))<br />    (eval<br />            (read (strcat<br />              "(defun " nom_cmd "( / rtn)"<br />                  "(if (setq app(fdvbfile " qapp "))"<br />                      "(vl-vbarun (strcat app "!" cmd ""))"<br />                      "(nodvbfile " qapp "))"<br />              "(princ))"<br />            )<br />            )<br />    )<br />              )<br />          )<br />        cmdliste<br />    )<br />    nil<br /> )<br /> <br /> (defun fdvbfile  (app)<br />    (if (not (findfile app))<br />        (if (not (findfile (strcat app ".dvb")))<br />            nil<br />            (strcat app ".dvb")<br />        )<br />        app<br />    )<br /> )<br />        <br /> (defun nodvbfile (filename)<br />    (princ (strcat "\n文件 " filename<br />          "(.dvb) 在搜索路径文件夹中未找到。" ) )<br />    (princ "\n请检查支持文件的安装，然后重试。")<br />    (princ)<br /> )<br /> (AutoVbaLoad "AlignEntity" '("AlignEntity" "AverageEntity" "AVE" "ALE"))<br />

对齐部分的演示已经在另外的贴子上贴了，这里只贴出均布部分的演示：

mccad

再试试看，因为我上面的那些图片都是使用预览后截图的。不应该会没有。

chb801

管理员的东东一定不错！

sdls

这个命令很好用，如果支持对齐散的对象（不是块或群组的对象和串联的），就完美了！

mccad

由于AutoCAD的BUG，使用触发事件来执行的VBA过程，当VBA过程带有对话框，则隐藏对话框时不能正常使用GETXXX方法，所以程序已经所以调整。
另外，该均布程序当设置行距或列距为0时可以当成对齐工具使用。也就是可以实现上下均布，同时左右对齐的功能。

bluemoon

我加载之后运行出现“无法加载这个对象，因为它不适用于这台计算机”
不知道是不是因为我的是cad2000？

mccad

因为我这里没有2000版调试。无法知道怎么回事。

mccad

程序已做修改，增加了出错处理。
对象对齐功能也按照均布的功能重新写代码。
解决问题：
1.对话框位置在隐藏后可显示在上次移动到的位置。
2.文本框空值时不能使用预览和确定键。
3.重置键在没有可重置项目时不能选。
4.点“指定行列间距”前，行距、列距不可选。
5.在均布到区域项选中时可以再使用选区域按钮(原来不行)。
6.过滤了射线和构造线的选定，避免出错。
7.选择区域的选择对象增加了出错检查。

mikewolf2k

bluemoon发表于2004-1-11 9:58:00我加载之后运行出现“无法加载这个对象，因为它不适用于这台计算机”
不知道是不是因为我的是cad2000？

不是cad2000的问题.我的可以用,不过有点问题,在屏幕上选点时鼠标失效,无显示也不响应按键,只能按esc退出.

mccad

请重新下载，已经做调整。

myfreemind

好程序，但好象预览没有