zzyong00 发表于 2015-4-13 20:52:09

[原创]用纯粹的几何计算的方法实现了Autocad的Curve类

本帖最后由 zzyong00 于 2015-4-13 20:55 编辑

用vba或vb进行Auotcad二次开发的人都知道，Autocad的VBA接口没有提供Vlisp中的vlax-curve-get族函数。如下：


没有这些函数，有时候开发时，总感觉缩手缩脚，而且，这些函数实现起来也不太容易，本人前一阵子用vlax类调用vlisp的这些函数，但是，太不稳定，经常无故出错，因此，决心自已写一个这样的组件！经过努力，终于有点结果了！
本COM组件的主要功能是用纯粹的几何计算的方法实现了Autocad的Curve类，目前支持曲线为：LWPOLYLINE,LINE,ARC,CIRCLE。本COM组件主要有三个文件组成：Curve17.dll,Curve18.dll,geometry.dll。其中Curve17.dll,Curve18.dll为activex dll，可以在任何文件夹中，只需要运行“注册.bat”注册一下即可，而geometry.dll为标准的dll，需要复制到c:\windows\system32(windowxp系统) 或C:\Windows\SysWOW64(window7系统) 中。

Curve17.dll对应于Autocad2007~Autocad2009，即R17;同理，Curve18.dll,对应于R18。
在这里做一个简单的演示：演示曲线上离指定点最近的点



演示代码(Project.dvb全部代码)：


Public Sub 点到曲线最近距离()

    Dim objSset As AcadSelectionSet

    SelectLots "MEA~PL~TMP~123", "LWPOLYLINE,LINE,ARC,CIRCLE"
    Set objSset = ThisDrawing.SelectionSets("MEA~PL~TMP~123")
    If objSset.Count = 0 Then Exit Sub
    '定义引用曲线类模块

    Dim ObjCurve As Object
    Set ObjCurve = CreateObject("Curve_zzyong00.Curve")

    Dim pt(2) As Double, pt1 As Variant, i As Long
    pt1 = ThisDrawing.Utility.GetPoint(, "请指定点：")
    pt(0) = pt1(0)
    pt(1) = pt1(1)
    For i = 0 To objSset.Count - 1
      Set ObjCurve.Entity = objSset.Item(i)
      Dim tmpPt As Variant
      tmpPt = ObjCurve.GetClosestPointTo(pt, False)
      ThisDrawing.ModelSpace.AddLine pt1, tmpPt
    Next i
End Sub
Public Sub SelectLots(ByVal Ssetname As String, ByVal objName As String)
    Dim sSetObj As AcadSelectionSet, flag As Boolean
    For Each sSetObj In ThisDrawing.SelectionSets
      If sSetObj.Name = Ssetname Then
            flag = True
            Exit For
      End If
    Next
    If flag Then sSetObj.Delete                                                 '创建集合，如集存在，则删除，新建
    Set sSetObj = ThisDrawing.SelectionSets.Add(Ssetname)
    ThisDrawing.Utility.Prompt "请选择对象，可以框选" & vbCrLf

    If objName <> "" Then
      Dim gpCode(0)    As Integer
      Dim dataValue(0) As Variant
      gpCode(0) = 0
      dataValue(0) = objName
      Dim groupCode As Variant, dataCode As Variant
      groupCode = gpCode
      dataCode = dataValue
      sSetObj.SelectOnScreen groupCode, dataCode
    ElseIf objName = "" Then
      sSetObj.SelectOnScreen
    End If
End Sub



更多演示请参照这个标桩号的例子：http://bbs.mjtd.com/forum.php?mo ... 2535&fromuid=332660

zzyong00 发表于 2024-1-6 10:42:57

787116960 发表于 2023-11-15 21:56
大佬在excelvba中运行不了 报错:运行时错误 '-2147221164 (80040154)':没有注册类

本COM组件主要有三个文件组成：Curve17.dll,Curve18.dll,geometry.dll。其中Curve17.dll,Curve18.dll为activex dll，可以在任何文件夹中，只需要运行“注册.bat”注册一下即可，而geometry.dll为标准的dll，需要复制到c:\windows\system32(windowxp系统) 或C:\Windows\SysWOW64(window7系统) 中。

zzyong00 发表于 2017-10-20 19:29:48

新鲜8 发表于 2017-10-20 12:14
问版主一个问题怎么用vba代码关闭CAD（不保存关闭）


Public Sub ss()
Dim objDoc As AcadDocument, objcad As AcadApplication
Set objcad = ThisDrawing.Application
For Each objDoc In objcad.Documents
    objDoc.Close False
Next
objcad.Quit

End Sub

787116960 发表于 2024-1-8 20:55:21

zzyong00 发表于 2024-1-6 10:42
本COM组件主要有三个文件组成：Curve17.dll,Curve18.dll,geometry.dll。其中Curve17.dll,Curve18.dll为ac ...

我想用excel中的vba来调用但是一直出现错误大佬能给个实例嘛

雪山飞狐_lzh 发表于 2015-4-13 22:35:56

我记得cad的ge曲线库应该是可以脱离cad环境直接在.net调用。这样看用vb.net结合com也许是更好的方法

zzyong00 发表于 2015-4-14 00:02:16

如果acge*.dll能够脱离cad环境直接被调用，哪可好了
我看了下acge18.dll，调用约定应该是cdecl方式,vb6正常情况下是不支持的

tester005 发表于 2015-4-14 13:24:47

楼主是vba板块新兴的中坚力量啊

mycad 发表于 2015-4-28 17:17:20

顶一下！！！！！！！！！！！

xinght99 发表于 2015-5-16 09:27:32

楼主为后起之星呀

你好小崧 发表于 2015-12-2 20:35:13

这个附件内容不支持CAD2006或者CAD2010吧？

zzyong00 发表于 2015-12-2 20:53:56

你好小崧 发表于 2015-12-2 20:35 static/image/common/back.gif
这个附件内容不支持CAD2006或者CAD2010吧？

Curve17.dll对应于Autocad2007~Autocad2009，即R17;同理，Curve18.dll,对应于R18,autocad2010-2012

zzyong00 发表于 2015-12-2 20:56:34

如需要其它版本，可以联系我

你好小崧 发表于 2015-12-2 20:57:30

zzyong00 发表于 2015-12-2 20:53 static/image/common/back.gif
Curve17.dll对应于Autocad2007~Autocad2009，即R17;同理，Curve18.dll,对应于R18,autocad2010-2012

公司只是部分人用2010以上的版本，大多还是用的2006
页: [1] 2 3 4
查看完整版本: [原创]用纯粹的几何计算的方法实现了Autocad的Curve类