皮皮网

1.VB.Net读取AutoCAD图纸
2.cad vba 样条曲线坐标

VB.Net读取AutoCAD图纸

       å¦‚果可以的话请把分给我

       ã€€ã€€ä»¥ä¸‹æ˜¯cad版的，引用autocad type library 和autocad/objectdbx common 如果是或者版本更低的只要引用autocad type library，代码的话大同小异，思路是一样的

 

       ã€€ã€€

           Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

               On Error Resume Next

               Dim acadapp As Autodesk.AutoCAD.Interop.AcadApplication

               acadapp = GetObject(vbNullString, "autoCAD.application")

               Dim acaddoc As Autodesk.AutoCAD.Interop.AcadDocument

               acaddoc = acadapp.ActiveDocument

               Dim Ms As Autodesk.AutoCAD.Interop.Common.AcadModelSpace

               Ms = acaddoc.ModelSpace

               Dim acadObjectI As Autodesk.AutoCAD.Interop.Common.AcadObject

               Dim Linei As Autodesk.AutoCAD.Interop.Common.AcadLine

               Dim Circlei As Autodesk.AutoCAD.Interop.Common.AcadCircle

               Dim Polylinei As Autodesk.AutoCAD.Interop.Common.AcadPolyline

               Dim pt As Autodesk.AutoCAD.Interop.Common.AcadPoint

               For Each acadObjectI In Ms

                   Debug.Print(acadObjectI.ObjectName)

                   Select Case acadObjectI.ObjectName

                       Case "AcDbLine"

                           Linei = acadObjectI

                           Debug.Print("X =" & Linei.StartPoint(0).ToString)

                           Debug.Print("Y =" & Linei.StartPoint(1).ToString)

                       Case ""

                       Case ""

                   End Select

               Next

           End Sub

cad vba 样条曲线坐标

       简单：首先要选择该样条曲线方法有两种，我就说说简单的thinkphp 游戏 源码下载一种！

       Sub www()

        Dim myspl As AcadSpline

        Dim selobj As Object

        Dim ppt As Variant

        ’以下do while 语句仅仅是1010兼职系统源码为了避免选择样条曲线时出错。如若简单点的pmsm电机 12864 源码话可以改成

        'ThisDrawing.Utility.GetEntity selobj, ppt, "请选择样条曲线"

        'Set myspl = selobj

        Do While code = 0

        On Error Resume Next

        ThisDrawing.Utility.GetEntity selobj, ppt, "请选择样条曲线"

        If Err <> 0 Then

        Err.Clear

        ThisDrawing.Utility.Prompt " 没有选定样条曲线对象,退出"

        Exit Sub

        End If

        If Err.Number = 0 Then

        If (selobj.EntityName = "AcDbSpline") Then

        Set myspl = selobj ‘将获取的曲线赋给变量myspl

        Exit Do

        End If

        Err.Clear

        End If

        Loop

        Dim np As Integer

        Dim pl() As Double

        Dim pt As Variant

        np = myspl.NumberOfFitPoints ’获取样条曲线的点数

        ReDim pl(0 To np * 3 - 1)

        Open "c:\1.txt" For Output As #1

        For i = 0 To np - 1

        pt = myspl.GetFitPoint(i) ‘获取样条曲线第i个点

        For j = 0 To 2

        pl(i * 3 + j) = pt(j)

        Next

        Print #1, pt(0), pt(1), pt(2) ’输出样条曲线的点坐标到.txt中

        Next

        ThisDrawing.ModelSpace.Add3DPoly pl ‘ 将样条曲线的点连成多段线

        Close #1

        ZoomAll

       End Sub