不同版本間的CAD開發

發表於 分類於 閱讀次數：

🙌前言

CAD版本有非常多種，我目前有接觸過的就有AutoCAD、ZWCAD以及現在正在使用中的ProgeCAD。

在使用VBA進行二次開發的過程，需要考量引用物件模型之間的差異，就目前開發經驗中，AutoCAD與ZWCAD可以透過修改引用名稱就可以有很好的轉換體驗，但是ProgeCAD的基底物件有比較不同的設計，故本篇要來解釋從AutoCAD的VBAcode如何透過我所撰寫的物件轉換函數進行相容，讓程式碼在ProgeCAD也可以順利動起來。

🔗HanksVBA學習歷程-不同CAD版本間也可以引用的Library(clsACAD)

🎯版本沿革

AutoCAD

AutoCAD為Autodesk公司旗下產品，產品比較沒有異常，程式碼範例豐富，社群支援完整度較高，同時也是最昂貴的軟體。

ZWCAD

ZWCAD為中望公司旗下產品，其實與AutoCAD都大同小異，費用比AutoCAD來的便宜，可惜政府機關不能接受中資，怕有資安疑慮。

ProgeCAD

ProgeCAD總部設立於義大利，採用IntelliCAD引擎驅動，就使用上不知怎麼說，就是覺得與AutoCAD少了一味，程式碼的運作比較緩慢，有些介面會跟AutoCAD有些許落差。

📌開發差異

之前的專案大多都是用於AutoCAD運作，自從機關買斷ProgeCAD之後，為了把程式碼移轉到ProgeCAD進行，需要了解一下程式碼開發之間的差異。

公共變數

公共變數的目的是為了能夠在各個function中相互傳遞變數使用

1
2
3
4
Private mo As Object
Private pa As Object
Public acadDoc As Object
Public CADVer As String

連接應用程式

這裡我在Sheets("總表")上面做了一個選單，讓使用者可以挑選要啟用哪個後期繫結字串，strCAD為VBA呼叫CAD應用程式連接字串，CADVer為各function連接後的細微調整判斷。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub Class_Initialize()

If Sheets("總表").optAutoCAD = True Then

    strCAD = "AutoCAD.application"
    CADVer = "AUTOCAD"
    
ElseIf Sheets("總表").optZWCAD = True Then
    
    strCAD = "ZWCAD.Application"
    CADVer = "ZWCAD"
    
ElseIf Sheets("總表").optICAD = True Then

    strCAD = "ICAD.application"
    CADVer = "ICAD"

End If

Call CADInit(strCAD)

End Sub

Private Sub CADInit(ByVal strCAD As String)

On Error Resume Next

Set acadApp = GetObject(, strCAD) '查看安裝
If Err <> 0 Then Set acadApp = CreateObject(strCAD)
acadApp.Visible = True

On Error GoTo 0

Set mo = acadApp.ActiveDocument.ModelSpace
Set pa = acadApp.ActiveDocument.PaperSpace
Set acadDoc = acadApp.ActiveDocument

End Sub

🌟物件相容轉換函數

  • AutoCAD的點物件是以一個陣列(array)儲存(0,1,2)double變數而成。
  • AutoCAD的線物件則分為LightWeightPolyline跟3dPolyline
    • LightWeigtPolyline是以一個陣列(vertice)至少儲存(0,1,2,3)生成，過程中不儲存高程，所以每2個值為一個點。
    • 3DPolyline是以一個陣列(vertice)至少儲存(0,1,2,3,4,5)生成，過程中儲存高程，所以每3個值為一個點。
  • ProgeCAD的點物件是以一個點物件(Point)，由X,Y,Z三個屬性儲存其變數而成。
  • ProgeCAD的線物件是以點群物件(Points)儲存點物件(Point)，取其變數而成。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Function tranPoint(ByVal CADpt)

If CADVer <> "ICAD" Then tranPoint = CADpt: Exit Function

Set tranPoint = Library.CreatePoint(CADpt(0), CADpt(1), CADpt(2))

End Function

Function tranIPoint(ByVal ICADpt)

If CADVer <> "ICAD" Then tranIPoint = ICADpt: Exit Function

Dim tmp(2) As Double
tmp(0) = ICADpt.X
tmp(1) = ICADpt.Y
tmp(2) = ICADpt.Z

tranIPoint = tmp

End Function

Function tranPoints(ByVal vertices, Optional cnt As Byte = 3)

If CADVer <> "ICAD" Then tranPoints = vertices: Exit Function

If vertices(2) = 0 Then cnt = 3

Dim myPline, myPoints, pt
    
Set myPoints = Library.CreatePoints

If cnt = 2 Then

    For i = 0 To UBound(vertices) Step cnt
    
        Set pt = Library.CreatePoint(vertices(i), vertices(i + 1))
    
        myPoints.Add
        myPoints(myPoints.Count - 1).X = pt.X
        myPoints(myPoints.Count - 1).Y = pt.Y
    
    Next

Else

    For i = 0 To UBound(vertices) Step cnt
    
        Set pt = Library.CreatePoint(vertices(i), vertices(i + 1), vertices(i + 2))
    
        myPoints.Add
        myPoints(myPoints.Count - 1).X = pt.X
        myPoints(myPoints.Count - 1).Y = pt.Y
        myPoints(myPoints.Count - 1).Z = pt.Z
    
    Next

End If

Set tranPoints = myPoints

End Function

Function tranIPoints(ByVal myPoints)

If CADVer <> "ICAD" Then tranIPoints = myPoints: Exit Function

Dim vertices()
ReDim vertices(myPoints.Count * 3 - 1)

For Each it In myPoints

vertices(0 + j) = it.X
vertices(0 + j + 1) = it.Y
vertices(0 + j + 2) = it.Z

j = j + 3

Next

tranIPoints = vertices

End Function

基本物件

畫點、畫圓、畫線、寫文字

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Function AddPoint(pt) As Object

If CADVer = "ICAD" Then
    Set AddPoint = mo.AddPointEntity(tranPoint(pt))
Else
    Set AddPoint = mo.AddPoint(tranPoint(pt))
End If

End Function

Function AddCircle(cpt, r) As Object

Set AddCircle = mo.AddCircle(tranPoint(cpt), r)

End Function

Function AddLine(spt, ept) As Object

Set AddLine = mo.AddLine(tranPoint(spt), tranPoint(ept))

End Function

Function AddLineCO(X1, Y1, X2, Y2) As Object

Dim spt(2) As Double
Dim ept(2) As Double
spt(0) = X1: spt(1) = Y1
ept(0) = X2: ept(1) = Y2

Set AddLineCO = AddLine(spt, ept)

End Function

Function AddPolyLine(vertices) As Object

Set AddPolyLine = mo.AddPolyLine(tranPoints(vertices))

End Function

Function Add3dPoly(vertices) '20210604 new

Set Add3dPoly = mo.Add3dPoly(tranPoints(vertices))

End Function

Function AddLWPolyLine(vertices) As Object

Set AddLWPolyLine = mo.AddLightWeightPolyline(tranPoints(vertices, 2))

End Function

Function AddArc(ByVal Center, Radius As Double, StartAngle As Double, EndAngle As Double)

Set AddArc = mo.AddArc(tranPoint(Center), Radius, StartAngle, EndAngle)

End Function

Function AddText(ByVal myText As String, ByVal txtpt, ByVal txtheight As Double, Optional alignmode As Byte = 1)

    Dim mtextObj As Object 'IntelliCAD.Text
    Dim insPt
    
    insPt = txtpt
    Set txtobj = mo.AddText(myText, tranPoint(insPt), txtheight)

    If CADVer = "ICAD" Then
    
        Select Case alignmode
        
        Case 1
            txtobj.HorizontalAlignment = 0  ' acAlignmentMiddleLeft
        Case 2
            txtobj.HorizontalAlignment = 4  ' acAlignmentMiddleCenter
        Case 3
            txtobj.HorizontalAlignment = 2 ' acAlignmentMiddleRight
        
        End Select
    
    Else
    
        Select Case alignmode
    
        Case 1
            txtobj.Alignment = 9 ' acAlignmentMiddleLeft
        Case 2
            txtobj.Alignment = 10 ' acAlignmentMiddleCenter
        Case 3
            txtobj.Alignment = 11 ' acAlignmentMiddleRight
            
        End Select
    
    End If
    
    txtobj.TextAlignmentPoint = tranPoint(insPt)

    Set AddText = txtobj

End Function

通用類別(Util)

通用類別用於與應用程式間的互動居多，包含取得點、取得文字。也包含CAD物件本身所提供的無法分類屬性，也會放入通用類別。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Function GetPoint(ByVal prompt As String)

If CADVer = "ICAD" Then

    Set o = IntelliCAD.ActiveDocument.Utility.GetPoint(, prompt)
    GetPoint = tranIPoint(o)

Else
    GetPoint = acadDoc.Utility.GetPoint(, prompt)
End If

End Function

Function GetString(ByVal prompt As String)

GetString = acadDoc.Utility.GetString(False, prompt & vbNewLine)

End Function

Function GetBoundingBox(ByVal entobj, MinX, MinY, MaxX, MaxY)

If CADVer = "ICAD" Then Call GetBoundingBox_ICAD(entobj, MinX, MinY, MaxX, MaxY): Exit Function

Call entobj.GetBoundingBox(Min, Max)

MinX = Min(0): MinY = Min(1)
MaxX = Max(0): MaxY = Max(1)

End Function

Function GetBoundingBox_ICAD(ByVal entobj, MinX, MinY, MaxX, MaxY)

Dim Min As Object
Dim Max As Object

Call entobj.GetBoundingBox(Min, Max)

MinX = Min.X: MinY = Min.Y
MaxX = Max.X: MaxY = Max.Y

End Function

🐞開發過程中的小問題

填充線也是常用於標示圖形的功能之一，這裡的AddHatch我一直試不出來，當初猜測可能是常數的問題vicHatchPatternTypePreDefined，結果還是一樣...

不同應用程式之間有時候常數設定會有所不同，包含排序的方式也可能會不同，像是在做selectionset(選擇集)的時候，AutoCAD可以很清楚知道順序，但是ProgeCAD似乎沒有一定的規則可言。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

Sub Hatch(ByVal obj As Object, ByVal Ratio As Double, ByVal ptrName As String)

'usually use "SOLID","ANSI32","AR-CONC"

If CADVer = "ICAD" Then Exit Sub

Dim hatchobj As Object 'AcadHatch
Dim outerloop(0 To 0) As Object 'AcadEntity

PatternName = ptrName

Set hatchobj = mo.AddHatch(0, PatternName, True)
'Set hatchobj = mo.AddHatch(vicHatchPatternTypePreDefined, PatternName, True)

hatchobj.PatternScale = 1 / Ratio * 4

Set outerloop(0) = obj

On Error Resume Next

hatchobj.AppendOuterLoop (outerloop)

End Sub

Function AddMixText(ByVal s As String, ByVal txtpt, ByVal txtheight As Double, _
                    Optional alignmode As Byte = 1, Optional dashmode As Integer = 0)

Dim txtobj As Object 'AcadText
Dim circleobj As Object 'AcadCircle

Set AddMixText = AddText(s, txtpt, txtheight, alignmode)

With mo

    Dim vertices(5) As Double

    If dashmode = 0 Then Exit Function
    
    Call GetBoundingBox(AddMixText, MinX, MinY, MaxX, MaxY)
    
    For i = 1 To dashmode
    
        vertices(0) = MinX
        vertices(1) = MinY - txtheight / 2 - txtheight / 2 * 0.5 * i
        
        vertices(3) = MaxX
        vertices(4) = vertices(1)
        
        Set plineobj = AddPolyLine(vertices)
        
        '******整體寬度尚未解決******
        
        If CADVer <> "ICAD" Then plineobj.ConstantWidth = txtheight / 10
    
    Next

End With

End Function

Function CreateSSET(Optional ByVal sname As String = "SS1", Optional ByVal ftypetmp As Variant = "", Optional ByVal fdatatmp As Variant = "")

'****PorgeCAD中似乎沒辦法做到過濾的條件?*****

'0:object type
'2:object name
'8:layer name
'62:color number(0 to 256)

Dim FilterType() As Integer
Dim FilterData() As Variant

On Error Resume Next: acadDoc.SelectionSets(sname).Delete: On Error GoTo 0

Set sset = acadDoc.SelectionSets.Add(sname)

If ftypetmp = "" Then

    sset.SelectOnScreen
    
Else

    ft = Split(ftypetmp, ",")
    fd = Split(fdatatmp, ",")
    
    ReDim FilterType(0 To UBound(ft))
    ReDim FilterData(0 To UBound(fd))
    
    For i = 0 To UBound(ft)
    
        FilterType(i) = ft(i)
        FilterData(i) = fd(i)
        
    Next
    
    sset.SelectOnScreen FilterType, FilterData
    
End If

Set CreateSSET = sset

End Function

Sub SetXdataToObj(ByVal obj As Object, ByVal xdata As String) '提供綁入字串使用

If CADVer = "ICAD" Then Exit Sub  '中心線樁無法提供
'*****用Handle處理?!***

Dim DataType(0 To 1) As Integer
Dim Data(0 To 1) As Variant

DataType(0) = 1001: Data(0) = xdata
DataType(1) = 1000: Data(1) = ""

obj.SetXData DataType, Data

End Sub


👉建議開發方向

通用才是王道，不管使用哪種應用程式，只要可以彼此匯入、匯出，最後都只是差在介面使用的習慣以及各應用程式獨立提供的功能而已。

如同前言所述，CAD版本有非常多種類型，在預算上若有所考量，其實也有FreeCAD、LibreCAD...等等開源選項。但若今天把大多數的開發時間都投在某一個CAD版本身上，未來如果公司要更換版本時，轉換成本會隨著你的開發時間而呈指數上升，程式碼越複雜問題越難查出來。

當今天開發人員已經決定要投資在CAD的二次開發上，我有幾點建議

  1. 確認文件是否豐富
  2. 社群平台是否有良好的支援
  3. 基底應用程式是否有細微bug
  4. 產出內容盡量以dxf為主

掌握好上面幾點，就差不多可以開始挑選CAD的題目，慢慢嘗試，遇到問題就看文件、不行就問別人，只要沒有本身的bug，基本上CAD的開發應該可以完成80%的工作流程，搭配dxf的產出內容，未來轉換也是沒有問題的。

💡Python輸出DXF(題外話)

python的ezdxf套件是我最近在使用streamlit開發時在使用，文件也算是相當詳細，這是一個單純用python所製作的CSV轉DXF專案，對於點資料轉成點物件應該有幫助，下載DXF之後只要匯入自己的CAD版本就可以進行後續使用了!

🔗CSV轉DXF-Streamlit