‘Buat Layer dengan nama Design
SetLayerAktif “Design”
‘Plot Garis (Polyline) Design di layer Design
PlotGaris2D LstKoordDesign, CDbl(BasePoint(0)), CDbl(BasePoint(1))

‘plot label dengan jarak baris exiting =1, design =1, tinggi huruf=0.1
x_section_label CDbl(BasePoint(0)), CDbl(BasePoint(1)), 1, 1, 0.1
End Sub

‘membaca koordinat x dan y, hasilnya disimpan di rtnListXY()
Dim i As Integer
i = -1
For Each cr In aRange.Columns(1).Cells
i = i + 2
ReDim Preserve rtnListXY(i)
rtnListXY(i – 1) = cr
rtnListXY(i) = cr.Offset(, 1)
Next
BacaListKoordinat = True
Exit Function
Err_Trap:
Err.Clear
BacaListKoordinat = False
End Function
‘==================
‘2. Objects AutoCAD
‘==================
Private Function ConnectAutoCAD() As Boolean
On Error Resume Next
ConnectAutoCAD = True
Set appCAD = GetObject(, “AutoCAD.Application”)
Set acadDoc = appCAD.ActiveDocument
Set acadMspace = acadDoc.ModelSpace
If Err.Number Then
ConnectAutoCAD = False
Exit Function
End If
End Function
Private Sub GantiWindowKeCAD()
AppActivate appCAD.Caption
End Sub

Private Function GetPointInCAD(strPrompt As String) As Variant
GetPointInCAD = acadDoc.Utility.GetPoint(, strPrompt)
End Function

Private Sub SetLayerAktif(strNamaLayer As String)
Dim aLayer As AcadLayer
On Error Resume Next
Set aLayer = acadDoc.Layers(strNamaLayer)
If Err.Number Then
Err.Clear
Set aLayer = acadDoc.Layers.Add(strNamaLayer)
End If
acadDoc.ActiveLayer = aLayer
End Sub

Private Sub PlotGaris2D(ListTitik() As Double, Optional Xorigin As Double = 0, Optional Yorigin As Double = 0)
Dim i As Integer
For i = LBound(ListTitik) To UBound(ListTitik) Step 2
ListTitik(i) = ListTitik(i) + Xorigin
ListTitik(i + 1) = ListTitik(i + 1) + Yorigin
Next i
acadMspace.AddLightWeightPolyline ListTitik
End Sub
Private Function GetOneEntity(ByVal strPrompt As String) As AcadEntity
Dim objEntity As AcadObject, PickedPoint(0 To 2) As Double
AppActivate appCAD.Caption
acadDoc.Utility.GetEntity objEntity, PickedPoint, strPrompt
Set GetOneEntity = objEntity
End Function
Private Sub x_section_label(Xorigin As Double, Yorigin As Double, _
TinggiBaris1 As Double, TinggiBaris2 As Double, TinggiHuruf As Double)

Dim anEntity As AcadEntity, polyExisting As AcadLWPolyline, polyDesign As AcadLWPolyline
Dim aText As AcadText

Dim i As Integer, stLine(0 To 2) As Double, edLine(0 To 2) As Double, Xmin As Double, Xmax As Double
Dim Existing_XY() As Double, Design_XY() As Double, Ymin As Double
Dim pntText(0 To 2) As Double, textRotation As Double

textRotation = Application.Radians(90)
Ymin = Yorigin – TinggiBaris1 – TinggiBaris2
Set anEntity = GetOneEntity(“Pilih Polyline Existing”)
If anEntity.ObjectName = “AcDbPolyline” Then
Set polyExisting = anEntity
Existing_XY = polyExisting.Coordinates
Xmin = Existing_XY(0)
‘gambar garis vertikal
SetLayerAktif “Grid Existing”
For i = LBound(Existing_XY) To UBound(Existing_XY) Step 2
stLine(0) = Existing_XY(i)
stLine(1) = Existing_XY(i + 1)
Xmax = stLine(0)
edLine(0) = stLine(0)
edLine(1) = Ymin
acadMspace.AddLine stLine, edLine

‘menulis text elevasi dan jarak
pntText(1) = Yorigin – TinggiBaris1
‘Label jarak
pntText(0) = stLine(0) – TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(0) – Xorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation
‘Label elevasi
pntText(0) = stLine(0) + TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(1) – Yorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

Next i
End If

‘Gambar Garis Base Line
SetLayerAktif “Datum”
stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin – TinggiBaris1: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin – TinggiBaris1 – TinggiBaris2: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

Set anEntity = GetOneEntity(“Pilih Polyline Design”)
If anEntity.ObjectName = “AcDbPolyline” Then
Set polyDesign = anEntity
Design_XY = polyDesign.Coordinates

‘menggambar garis vertikal di layer grid design
SetLayerAktif “Grid Design”
For i = LBound(Design_XY) To UBound(Design_XY) Step 2
stLine(0) = Design_XY(i)
stLine(1) = Design_XY(i + 1)

edLine(0) = stLine(0)
edLine(1) = Ymin
acadMspace.AddLine stLine, edLine

‘menulis text elevasi dan jarak
pntText(1) = Yorigin – TinggiBaris1 – TinggiBaris2

‘Label jarak
pntText(0) = stLine(0) – TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(0) – Xorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

‘Label elevasi
pntText(0) = stLine(0) + TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(1) – Yorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

Next i
End If
End Sub

‘===end private sub dan function”