VBA动态拖动的实现
本帖最后由 作者 于 2009-2-13 13:33:16 编辑 <br /><br /> <p>长久以来,VBA被认为在动态拖动方面是最性无能的,我通过VBA调用一个动态链接库实现了久此以来都没有解决的VBA动态拖动问题</p><p>在这里我编写了一个标准动态链接库函数，用以让VBA实时得到坐标点</p><p>在VB或VBA中，它这样被使用</p><p>Declare Function getpt Lib "CaiqsVBApinvoke.arx" (ByRef x As Double, ByRef y As Double, ByRef z As Double) As Integer</p><p>上面是函数声明</p><p>调用时</p><p>dim ret as Integer</p><p>ret = getpt(x, y, z)'这里得到实时坐标</p><p>先将附件里的arx放到AutoCAD安装目录，不用加载</p><p>看我下边的例子程序及演</p><p>Declare Function getpt Lib "CaiqsVBApinvoke.arx" (ByRef x As Double, ByRef y As Double, ByRef z As Double) As Integer<br/>Sub aa()<br/>Dim moda As Integer<br/>mymode = 0<br/>Dim x, y, z As Double<br/>Dim ret As Integer<br/>ret = getpt(x, y, z)<br/>Dim abc As AcadEntity<br/>Dim pt As Variant<br/>ThisDrawing.ActiveSelectionSet.SelectOnScreen<br/>Dim oldpt As Variant<br/>Dim newpt(2) As Double<br/>oldpt = ThisDrawing.Utility.GetPoint(, "\n指定移动起点: ")<br/>Dim mylne As AcadLine<br/>ret = getpt(x, y, z)<br/>Dim startpt(2) As Double<br/>Dim endpt(2) As Double<br/>endpt(0) = x: endpt(1) = y: endpt(2) = z<br/>Set mylne = ThisDrawing.ModelSpace.AddLine(oldpt, endpt)</p><p>Dim tmp(0) As Double<br/>Do While ret = 1<br/>ret = getpt(x, y, z)</p><p>newpt(0) = x: newpt(1) = y: newpt(2) = z<br/>mylne.EndPoint = newpt<br/>For Each ent In ThisDrawing.ActiveSelectionSet<br/>ent.Move oldpt, newpt</p><p><br/>Next</p><p>oldpt(0) = newpt(0): oldpt(1) = newpt(1): oldpt(2) = newpt(2)<br/>Loop<br/>mylne.Delete<br/>End Sub</p><p> </p> <p>请问ARX可以加载到2004中吗？</p> 非常有用，但是用起来不是很方便呢，这个例子都只能通过右键结束命令，用法还需要研究下！非常感谢楼主提供的好东西！ <p>文件未找到，无论文件放在哪里，都是一样，文件名加上路径也说文件未找到</p><p>运行时错误53</p> 适用于cad04-06,arx可加载或放cad目录或放操作系统目录中 <p>我的也提示“文件未找到“</p><p>无论文件放在哪里，都是一样，文件名加上路径也说文件未找到</p><p>运行时错误53”</p><p>我的是 2008 </p><p></p> <p>移动结束只能用右键结束么？实用性不强啊。</p><p>mylne.EndPoint = newpt后面加一句mylne.Highlight True就更像了</p> 本帖最后由 作者 于 2009-3-27 21:29:40 编辑这个功能用VL类也可以实现 请问能用左键结束移动命令吗?这样更方便! 我已解决用右键结束命令这个缺陷，用API函数。
页:
[1]
2