使用python操作autocad2007

dogingate

1. <div class="blockcode"><blockquote>from pyAutoCAD import Autocad, APoint
   
2. 
   
3. dblSpan = 16000
   
4. intBeamsCount = 8
   
5. dblBeamDist = 1000
   
6. dblSideDist = 300
   
7. intElesCount = 16
   
8. 
   
9. acad = Autocad(create_if_not_exists=True)
   
10. acad.prompt('welcome back!')
    
11. 
    
12. # #set the new created layer to the current layer
    
13. # acad.ActiveDocument.ActiveLayer=olayer
    
14. 
    
15. # 1 read,2 yellow,3 green,4 qing,5 blue,6 yanghong,7 white/black
    
16. layers_color = [1, 2, 3]
    
17. layers_name = ['zhuliang', 'xuliang', 'zhizuo']
    
18. layers_linetype = ['continuous', 'continuous', 'continuous']
    
19. 
    
20. for i in range(len(layers_name)):
    
21.     olayer = acad.ActiveDocument.Layers.Add(layers_name[i])
    
22.     olayer.color = layers_color[i]
    
23.     olayer.Linetype = layers_linetype[i]
    
24. 
    
25. # 当前文件模型空间中所包含的图层总数
    
26. layers_nums = acad.ActiveDocument.Layers.count
    
27. # 当前文件模型空间中所包含的所有图层名称
    
28. layers_names = [acad.ActiveDocument.Layers.Item(i).Name for i in range(layers_nums)]
    
29. 
    
30. # 获取指定图层索引号
    
31. index = layers_names.index('zhuliang')
    
32. # 将指定图层设定当前
    
33. acad.ActiveDocument.ActiveLayer = acad.ActiveDocument.Layers.Item(index)
    
34. 
    
35. # add some objects to document
    
36. p1 = APoint(0, 0)
    
37. p2 = APoint(dblSpan, 0)
    
38. for i in range(0, intBeamsCount):
    
39.     acad.model.AddLine(p1, p2)
    
40.     p1 = APoint(0, p1[1]+dblBeamDist)
    
41.     p2 = APoint(dblSpan, p1[1])
    
42. 
    
43. # 获取指定图层索引号
    
44. index = layers_names.index('xuliang')
    
45. # 将指定图层设定当前
    
46. acad.ActiveDocument.ActiveLayer = acad.ActiveDocument.Layers.Item(index)
    
47. 
    
48. dist = dblSpan/intElesCount
    
49. p1 = APoint(dist/2, -dblSideDist)
    
50. p2 = APoint(dist/2, (intBeamsCount-1)*dblBeamDist+dblSideDist)
    
51. for i in range(0, intElesCount):
    
52.     acad.model.AddLine(p1, p2)
    
53.     p1 = APoint(p1[0]+dist, p1[1])
    
54.     p2 = APoint(p2[0]+dist, p2[1])

复制代码

dogingate

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

2. Sub deleteTextAndDimension()
   
3.    
   
4.     Dim oSS As Object
   
5.     On Error Resume Next
   
6.     If Not IsNull(ThisDrawing.SelectionSets.Item("Wolf")) Then
   
7.         Set oSS = ThisDrawing.SelectionSets.Item("wolf")
   
8.         oSS.Delete
   
9.     End If
   
10.     Set oSS = ThisDrawing.SelectionSets.Add("wolf")
    
11. 
    
12.     On Error GoTo catchError
    
13.     Dim fType() As Integer
    
14.     Dim fData As Variant
    
15.       strFilterType = "-4,0,0,-4"
    
16.     strFilterData = "<or,text,dimension,or>"
    
17.     Call createFilter(fType, fData, strFilterType, strFilterData)
    
18. 
    
19.     oSS.SelectOnScreen fType, fData
    
20.     oSS.Highlight ture
    
21.     oSS.Erase
    
22.     oSS.Delete
    
23. 
    
24. exitSub:
    
25.     Exit Sub
    
26. catchError:
    
27.     ' add error handling
    
28.     If Err Then
    
29.         Err.Clear
    
30.         MsgBox Err.Description
    
31.     End If
    
32.    
    
33. End Sub
    
34. 
    
35. Sub createFilter(fType, fData, strFilterType, strFilterData)
    
36.     '// add declarations
    
37.     On Error GoTo catchError
    
38.     arrFilterType = Split(strFilterType, ",")
    
39.     arrFilterData = Split(strFilterData, ",")
    
40.     If UBound(arrFilterType) = UBound(arrFilterData) Then
    
41.         intFilterCount = UBound(arrFilterType)
    
42.         ReDim fType(intFilterCount)
    
43.         ReDim fData(intFilterCount)
    
44.         For i = 0 To UBound(arrFilterType)
    
45.             fType(i) = arrFilterType(i)
    
46.             fData(i) = arrFilterData(i)
    
47.         Next i
    
48.     Else
    
49.         GoTo exitFunction
    
50.     End If
    
51. 
    
52. exitFunction:
    
53.     Exit Sub
    
54. catchError:
    
55.     '// add error handling
    
56.     GoTo exitFunction
    
57. End Sub

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

dogingate

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

2. Sub Example_AddLine()
   
3.     ' 该示例在模型空间中添加直线。
   
4.     Dim oline As AcadLine
   
5.     Dim startPoint(0 To 2) As Double
   
6.     Dim endPoint(0 To 2) As Double
   
7.     Dim dblSpan As Double
   
8.     Dim intBeamsCount As Integer
   
9.     Dim intElesCount As Integer
   
10.        Dim dblBeamDist As Double
    
11.     Dim dblSideDist As Double
    
12.    
    
13.      intElesCount = 20
    
14.     dblSideDist = 300
    
15.     dblBeamDist = 1000
    
16.     intBeamsCount = 12
    
17.     dblSpan = 16000
    
18.     '定义直线的起点和终点
    
19.     startPoint(0) = 0#: startPoint(1) = 0#: startPoint(2) = 0#
    
20.     endPoint(0) = dblSpan: endPoint(1) = 0#: endPoint(2) = 0#
    
21.     For i = 1 To intBeamsCount
    
22.         ' 在模型空间中创建直线
    
23.         Set oline = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    
24.         startPoint(0) = startPoint(0): startPoint(1) = startPoint(1) + dblBeamDist: startPoint(2) = 0#
    
25.         endPoint(0) = dblSpan: endPoint(1) = startPoint(1): endPoint(2) = 0#
    
26.     Next i
    
27.    
    
28.     startPoint(0) = dblSpan / intElesCount / 2: startPoint(1) = -dblSideDist: startPoint(2) = 0#
    
29.     endPoint(0) = dblSpan / intElesCount / 2: endPoint(1) = (intBeamsCount - 1) * dblBeamDist + dblSideDist: endPoint(2) = 0#
    
30.     For i = 1 To intElesCount
    
31.          Set oline = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    
32.          startPoint(0) = startPoint(0) + dblSpan / intElesCount: startPoint(1) = startPoint(1): startPoint(2) = 0#
    
33.          endPoint(0) = startPoint(0): endPoint(1) = endPoint(1): endPoint(2) = 0#
    
34.     Next i
    
35.    
    
36.     ZoomAll
    
37. End Sub
    

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

dogingate

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

1. from pyautocad import Autocad, APoint
   
2. 
   
3. from win32com.client import VARIANT
   
4. from win32com.client import Dispatch
   
5. import pythoncom
   
6. 
   
7. def vtpnt(x, y, z=0):
   
8.     """坐标点转化为浮点数"""
   
9.     return VARIANT(pythoncom.VT_ARRAY | pythoncom.VT_R8, (x, y, z))
   
10. 
    
11. def vtobj(obj):
    
12.     """转化为对象数组"""
    
13.     return VARIANT(pythoncom.VT_ARRAY | pythoncom.VT_DISPATCH, obj)
    
14. 
    
15. def vtFloat(list):
    
16.     """列表转化为浮点数"""
    
17.     return VARIANT(pythoncom.VT_ARRAY | pythoncom.VT_R8, list)
    
18.    
    
19. def vtInt(list):
    
20.     """列表转化为整数"""
    
21.     return VARIANT(pythoncom.VT_ARRAY | pythoncom.VT_I2, list)
    
22. 
    
23. def vtVariant(list):
    
24.     """列表转化为变体"""
    
25.     return VARIANT(pythoncom.VT_ARRAY | pythoncom.VT_VARIANT, list)
    
26. 
    
27. #AutoCAD2007 ProgId is "AutoCAD.Application.17"
    
28. acad = Dispatch("AutoCAD.Application.17")  
    
29. doc = acad.ActiveDocument
    
30. doc.Utility.Prompt("Hello AutoCAD\n")
    
31. mp = doc.ModelSpace
    
32. 
    
33. if doc.SelectionSets.count>0:
    
34.     try:
    
35.         doc.SelectionSets.Item("SS1").Delete()
    
36.     except:
    
37.         print("Delete selection failed")
    
38. 
    
39. slt = doc.SelectionSets.Add("SS1")
    
40. 
    
41. filterType = [-4, 0, 0, -4]  # 定义过滤类型
    
42. filterData = ["<OR", "TEXT", "DIMENSION", "OR>"]  # 设置过滤参数
    
43. 
    
44. filterType = vtInt(filterType)  # 数据类型转化
    
45. filterData = vtVariant(filterData)  # 数据类型转化
    
46. 
    
47. # object.Select(Mode, Point1, Point2, FilterType, FilterData)
    
48. slt.SelectOnScreen(filterType, filterData)  # 实现过滤
    
49. obj = slt[0]
    
50. slt.Erase()  # 删除符合条件的所有圆
    

复制代码

panliang9

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

dogingate

panliang9 发表于 2020-6-19 09:35
在AUTOCAD2007下运行了一下VBA，画出一系列1000x800的网格，是这样的吗。

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

dogingate

几个参考文档

dogingate

贴一个VB

2. Sub sortPlineByX(arr)
   
3. Dim i&, j&, vSwap, min&
   
4. For i = LBound(arr, 1) To UBound(arr, 1)
   
5.     min = i
   
6.     For j = i + 1 To UBound(arr, 1)
   
7.         If arr(min, 0) > arr(j, 0) Then min = j
   
8.     Next
   
9.     If min <> i Then
   
10.         For k = 0 To 4
    
11.             vSwap = arr(min, k): arr(min, k) = arr(i, k): arr(i, k) = vSwap
    
12.         Next k
    
13.     End If
    
14. Next i
    
15. 
    
16. End Sub

Sub sortPlineByX(arr)<br /> Dim i&, j&, vSwap, min&<br /> For i = LBound(arr, 1) To UBound(arr, 1)<br />     min = i<br />     For j = i + 1 To UBound(arr, 1)<br />         If arr(min, 0) > arr(j, 0) Then min = j<br />     Next<br />     If min <> i Then<br />         For k = 0 To 4<br />             vSwap = arr(min, k): arr(min, k) = arr(i, k): arr(i, k) = vSwap<br />         Next k<br />     End If<br /> Next i<br /> <br /> End Sub

A的排序算法

guangdonglbq

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

guangdonglbq

dogingate 发表于 2020-6-19 14:30
几个参考文档

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