社区 › VB › 使用python操作autocad2007

dogingate 发表于 2020-6-18 14:16:00

使用python操作autocad2007

复制代码

dogingate 发表于 2020-6-19 14:08:00

与上一个帖子同样的功能，用VBA实现

Sub deleteTextAndDimension()
   
    Dim oSS As Object
    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets.Item("Wolf")) Then
      Set oSS = ThisDrawing.SelectionSets.Item("wolf")
      oSS.Delete
    End If
    Set oSS = ThisDrawing.SelectionSets.Add("wolf")
    On Error GoTo catchError
    Dim fType() As Integer
    Dim fData As Variant
      strFilterType = "-4,0,0,-4"
    strFilterData = ""
    Call createFilter(fType, fData, strFilterType, strFilterData)
    oSS.SelectOnScreen fType, fData
    oSS.Highlight ture
    oSS.Erase
    oSS.Delete
exitSub:
    Exit Sub
catchError:
    ' add error handling
    If Err Then
      Err.Clear
      MsgBox Err.Description
    End If
   
End Sub
Sub createFilter(fType, fData, strFilterType, strFilterData)
    '// add declarations
    On Error GoTo catchError
    arrFilterType = Split(strFilterType, ",")
    arrFilterData = Split(strFilterData, ",")
    If UBound(arrFilterType) = UBound(arrFilterData) Then
      intFilterCount = UBound(arrFilterType)
      ReDim fType(intFilterCount)
      ReDim fData(intFilterCount)
      For i = 0 To UBound(arrFilterType)
            fType(i) = arrFilterType(i)
            fData(i) = arrFilterData(i)
      Next i
    Else
      GoTo exitFunction
    End If
exitFunction:
    Exit Sub
catchError:
    '// add error handling
    GoTo exitFunction
End Sub

dogingate 发表于 2020-6-18 14:18:00

以下是VBA代码，实现相同的功能，都在autocad2007里面测试完成，本来是想用vba，但是滚轮插件实现不了，老是有问题，刚好看到有Pyautocad，就试了下，效果还不错，可以对比下

Sub Example_AddLine()
    ' 该示例在模型空间中添加直线。
    Dim oline As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    Dim dblSpan As Double
    Dim intBeamsCount As Integer
    Dim intElesCount As Integer
       Dim dblBeamDist As Double
    Dim dblSideDist As Double
   
   intElesCount = 20
    dblSideDist = 300
    dblBeamDist = 1000
    intBeamsCount = 12
    dblSpan = 16000
    '定义直线的起点和终点
    startPoint(0) = 0#: startPoint(1) = 0#: startPoint(2) = 0#
    endPoint(0) = dblSpan: endPoint(1) = 0#: endPoint(2) = 0#
    For i = 1 To intBeamsCount
      ' 在模型空间中创建直线
      Set oline = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
      startPoint(0) = startPoint(0): startPoint(1) = startPoint(1) + dblBeamDist: startPoint(2) = 0#
      endPoint(0) = dblSpan: endPoint(1) = startPoint(1): endPoint(2) = 0#
    Next i
   
    startPoint(0) = dblSpan / intElesCount / 2: startPoint(1) = -dblSideDist: startPoint(2) = 0#
    endPoint(0) = dblSpan / intElesCount / 2: endPoint(1) = (intBeamsCount - 1) * dblBeamDist + dblSideDist: endPoint(2) = 0#
    For i = 1 To intElesCount
         Set oline = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
         startPoint(0) = startPoint(0) + dblSpan / intElesCount: startPoint(1) = startPoint(1): startPoint(2) = 0#
         endPoint(0) = startPoint(0): endPoint(1) = endPoint(1): endPoint(2) = 0#
    Next i
   
    ZoomAll
End Sub

dogingate 发表于 2020-6-19 14:08:00

这段代码用于在屏幕上选中的对象删除其中的文字和标注
复制代码

panliang9 发表于 2020-6-19 09:35:00

在AUTOCAD2007下运行了一下VBA，画出一系列1000x800的网格，是这样的吗。

dogingate 发表于 2020-6-19 10:51:00

是的，你可以调整参数，改一下代码，做类似的事情

dogingate 发表于 2020-6-19 14:30:00

几个参考文档

dogingate 发表于 2020-6-20 11:31:00

贴一个VB
Sub sortPlineByX(arr)
Dim i&, j&, vSwap, min&
For i = LBound(arr, 1) To UBound(arr, 1)
    min = i
    For j = i + 1 To UBound(arr, 1)
      If arr(min, 0) > arr(j, 0) Then min = j
    Next
    If mini Then
      For k = 0 To 4
            vSwap = arr(min, k): arr(min, k) = arr(i, k): arr(i, k) = vSwap
      Next k
    End If
Next i
End SubA的排序算法

guangdonglbq 发表于 2020-6-24 10:03:00

python的话，直接用非狐的pycad不是更好？不过pycad是用来替换.net的

guangdonglbq 发表于 2020-6-24 10:04:00

这些文件，一般在完整版的acad的help目录（如\AutoCAD 2008\Help）下都有。

查看完整版本: 使用python操作autocad2007