vba/vb编写的标注道路桩号的源代码！

zzyong00

在本论坛的lisp版，有些高手放出了标注桩号的一些lisp代码，但在vba/vb版，却一个也没有，客观上讲，这是vba的一些弱项导致的，在vba中，没有Curve类，也没有vlax-curve-get族函数，如下：

1. vlax-curve-getPointAtDist
   
2. vlax-curve-getPointAtParam ;
   
3. vlax-curve-getDistAtPoint ;
   
4. vlax-curve-getDistAtParam ;
   
5. vlax-curve-getParamAtPoint ;;
   
6. vlax-curve-getParamAtDist ;;
   
7. vlax-curve-getStartParam ;;
   
8. vlax-curve-getendParam ;;
   
9. vlax-curve-getStartPoint ;;;
   
10. vlax-curve-getEndPoint;;
    
11. vlax-curve-getFirstDeriv;;
    
12. vlax-curve-getSecondDeriv;;
    
13. vlax-curve-getSecondDeriv

vlax-curve-getPointAtDist <br /> vlax-curve-getPointAtParam ;<br /> vlax-curve-getDistAtPoint ;<br /> vlax-curve-getDistAtParam ;<br /> vlax-curve-getParamAtPoint ;;<br /> vlax-curve-getParamAtDist ;;<br /> vlax-curve-getStartParam ;;<br /> vlax-curve-getendParam ;;<br /> vlax-curve-getStartPoint ;;;<br /> vlax-curve-getEndPoint;;<br /> vlax-curve-getFirstDeriv;;<br /> vlax-curve-getSecondDeriv;;<br /> vlax-curve-getSecondDeriv

如果自己实现以上函数，达到Autodesk函数的水平，实在不容易（也不是不可能），幸好，我们有vb调用lisp的类VLAX.cls（BY Frank Oquendo）,而且，这位大神Frank Oquendo，还实现了Curve.cls类，让我们后来人轻松了很多！在此，我向前辈致敬！
由于源码中用的很多函数或过程都在这个帖子：http://bbs.mjtd.com/forum.php?mo ... 2535&fromuid=332660
所以，还请各位移步！
看效果：

雪山飞狐_lzh

http://bbs.mjtd.com/thread-107745-1-1.html
刚看了下 efan的是用Arx做得Com组件，，不过支持的版本不多
原则上用VBA可以直接调用Arx的函数，efan以前也做过很多研究
有时间的话 我试试用.Net做个Com库看看

zzyong00

雪山飞狐_lzh 发表于 2015-4-5 23:30
http://bbs.mjtd.com/thread-107745-1-1.html
刚看了下 efan的是用Arx做得Com组件，，不过支持的版本不多
...

我没有2013，我用2014 x64测试他的arx，好像输出一个时间，但对象不能创建成功，不知道他的arx设置有过期时间，还是的确无法调用！
期盼雪版的.Net版的Curve类com库出世！

zzyong00

雪山飞狐_lzh 发表于 2015-4-5 23:30
http://bbs.mjtd.com/thread-107745-1-1.html
刚看了下 efan的是用Arx做得Com组件，，不过支持的版本不多
...

刚才在2004下测试efan的arx是成功的，不过，efan封装的不全，没有vlax-curve-getFirstDeriv，vlax-curve-getSecondDeriv

雪山飞狐_lzh

1.0测试版 解压上面文件后，把他们放到d:\TlsCad\Bin里面 本来写注册表可以直接做到程序里 但是测试版先随意了
运行1.reg注册
然后在cad里nerload安装。。。正式版上面的步骤会少掉
VBA引用TlsCad.Common.tlb



测试代码

1. Sub tt()
   
2. 
   
3. Dim cm As TlsCad_Common.CurveManager
   
4. Set cm = Application.GetInterfaceObject("TlsCad.Common.CurveManager")
   
5. 
   
6. Dim obj As AcadEntity, pnts(1)
   
7. ThisDrawing.Utility.GetEntity obj, pnts(0)
   
8. 
   
9. Dim cc As TlsCad_Common.Curve
   
10. Set cc = cm.Add(obj.ObjectID)
    
11. 
    
12. pnts(0) = cc.GetClosestPointTo(pnts(0), False)
    
13. pnts(1) = ThisDrawing.Utility.GetPoint()
    
14. pnts(1) = cc.GetClosestPointTo(pnts(1), False)
    
15. 
    
16. cc.SplitByParams cc.GetParamsByPoints(pnts)
    
17. obj.Delete
    
18. cc.Dispose
    
19. 
    
20. End Sub

Sub tt()<br /> <br /> Dim cm As TlsCad_Common.CurveManager<br /> Set cm = Application.GetInterfaceObject("TlsCad.Common.CurveManager")<br /> <br /> Dim obj As AcadEntity, pnts(1)<br /> ThisDrawing.Utility.GetEntity obj, pnts(0)<br /> <br /> Dim cc As TlsCad_Common.Curve<br /> Set cc = cm.Add(obj.ObjectID)<br /> <br /> pnts(0) = cc.GetClosestPointTo(pnts(0), False)<br /> pnts(1) = ThisDrawing.Utility.GetPoint()<br /> pnts(1) = cc.GetClosestPointTo(pnts(1), False)<br /> <br /> cc.SplitByParams cc.GetParamsByPoints(pnts)<br /> obj.Delete<br /> cc.Dispose<br /> <br /> End Sub

zzyong00

雪山飞狐_lzh 发表于 2015-4-6 20:42
1.0测试版 解压上面文件后，把他们放到d:\TlsCad\Bin里面 本来写注册表可以直接做到程序里 但是测试版先随 ...

版主你好，辛苦了！
我电脑里只有64位的Autocad，obj.ObjectID是longptr类型，与您tlb里定义的类型long不一致。
如果我把ObjectID用ObjectID32代替，就会出现以下问题：

zzyong00

用.net写的dll，是不是各cad版本都得分别编译？

雪山飞狐_lzh

没考虑64位的问题你把64位cad的mgd文件上传我看看
Acmgd.dll
Acdbmgd.dll
Actcmgd.dll

雪山飞狐_lzh

应该2008到2012 32位通用吧 64位没用过不知道 13以上高版本就要重编了吧

zzyong00

我在autocad2008下也没用调用成功