我必须承认RICVBA有道理。我的目的是看看在写一段代码时我能把我的知识（不是那么广博）推到多大程度，同时也要加快我的工作过程。
这是代码。我承认这可能会让人困惑，但这只是一个过程中的版本。用户输入两个变量，即道路宽度和横截面之间的距离，然后在屏幕上依次选择道路的第一个点、最后一个点和它们之间的所有路段。
- Private Sub CommandButton1_Click()
- Dim SOS As AcadSelectionSet
- Dim objSS As AcadSelectionSet
- Dim PopLin As AcadLine
- Dim Kruzic As AcadCircle
- Dim objent As AcadEntity
- Dim Pravac As AcadLine
- Dim PrKrivina As AcadLWPolyline
- Dim Luk As AcadArc
- Dim Rluk, Alfa As Double
- Dim L, Lpravac, Lprkriv, Lluk, Lostatak As Double
- Dim PocToc As Variant
- Dim ZadToc As Variant
- Dim PrvaTocka(0 To 2) As Double
- Dim DrugaTocka(0 To 2) As Double
- Dim RazProf, SirCest As Double
- Dim Krug As AcadCircle
- Dim sjeciste As Variant
- Dim sjeciste2 As Variant
- Dim BrProfila, i, n As Integer
- Dim PlusMinus As Boolean
- Dim Rpoplin As Double
- Dim pi As Double
- Dim linija, linija1, linija2 As AcadLine
- Dim BrojacProfila As Integer
- Dim SredisnjaTockaLuka As Variant
- Dim BrPomaka, brojX As Integer
- Dim kolicnik As Double
- Dim PomocnaTocka1(0 To 2) As Double
- Dim PomocnaTocka2(0 To 2) As Double
- Dim BrTocakaPlinea, Kocnica, LostatakPrKr As Integer
- Dim Lpomocni As Double
- Dim KoorNaopakePrKr() As Double
-
- UserForm1.hide
- pi = 3.14159265358979
- RazProf = txtRazProf.Value
- SirCest = txtSirCest.Value
- Rpoplin = SirCest * 2
- PocToc = ThisDrawing.Utility.GetPoint(, "Odaberite pocetnu tocku trase")
- ZadToc = ThisDrawing.Utility.GetPoint(, "Odaberite zadnju tocku trase")
- For Each SOS In ThisDrawing.SelectionSets
- If SOS.Name = "MySS" Then
- ThisDrawing.SelectionSets("MySS").Delete
- Exit For
- End If
- Next
-
- ThisDrawing.SelectionSets.Add ("MySS")
- Set objSS = ThisDrawing.SelectionSets("MySS")
- objSS.SelectOnScreen
-
- If objSS.Count < 1 Then Exit Sub
-
- i = 0
- L = 0
- Lostatak = 0
- PlusMinus = False
-
-
- '********GLAVNI DIO PROGRAMA********
- For Each objent In objSS
- Select Case objent.ObjectName
-
- '<<<<<PRAVAC>>>>>
- Case "AcDbLine"
- Set Pravac = objent
- PlusMinus = False
- L = L + Pravac.Length
- 'Ako pravac nije prvi element trase
- If Abs(DrugaTocka(0) - Pravac.StartPoint(0)) < 0.000001 And Abs(DrugaTocka(1) - Pravac.StartPoint(1)) < 0.000001 _
- And PrvaTocka(0) <> Pravac.EndPoint(0) And PrvaTocka(1) <> Pravac.EndPoint(1) Then
- PrvaTocka(0) = DrugaTocka(0)
- PrvaTocka(1) = DrugaTocka(1)
- PrvaTocka(2) = DrugaTocka(2)
- DrugaTocka(0) = Pravac.EndPoint(0)
- DrugaTocka(1) = Pravac.EndPoint(1)
- DrugaTocka(2) = Pravac.EndPoint(2)
- PlusMinus = True
- End If
- If Abs(DrugaTocka(0) - Pravac.EndPoint(0)) < 0.000001 And Abs(DrugaTocka(1) - Pravac.EndPoint(1)) < 0.000001 _
- And PrvaTocka(0) <> Pravac.StartPoint(0) And PrvaTocka(1) <> Pravac.StartPoint(1) Then
- PrvaTocka(0) = DrugaTocka(0)
- PrvaTocka(1) = DrugaTocka(1)
- PrvaTocka(2) = DrugaTocka(2)
- DrugaTocka(0) = Pravac.StartPoint(0)
- DrugaTocka(1) = Pravac.StartPoint(1)
- DrugaTocka(2) = Pravac.StartPoint(2)
- PlusMinus = True
- End If
- If PlusMinus = True Then
- If Pravac.Length > Lostatak Then
- BrProfila = (Pravac.Length - Lostatak) \ RazProf
- kolicnik = (Pravac.Length - Lostatak) / RazProf
- If BrProfila > kolicnik Then
- BrProfila = BrProfila - 1
- End If
- For i = 1 To BrProfila
- 'Za sve ostale profile
- Set Krug = ThisDrawing.ModelSpace.AddCircle _
- (PrvaTocka, (RazProf * (i - 1) + Lostatak))
- sjeciste = Pravac.IntersectWith(Krug, acExtendNone)
- Set Kruzic = ThisDrawing.ModelSpace.AddCircle(sjeciste, SirCest / 3.5)
- Krug.Delete
- Set Krug = ThisDrawing.ModelSpace.AddCircle _
- (PrvaTocka, (RazProf * (i - 1) + Lostatak + Rpoplin))
- sjeciste = Pravac.IntersectWith(Krug, acExtendNone)
- Set linija = ThisDrawing.ModelSpace.AddLine(Kruzic.Center, sjeciste)
- linija.Rotate Kruzic.Center, pi / 2
- Set PopLin = ThisDrawing.ModelSpace.AddLine(linija.EndPoint, Kruzic.Center)
- linija.Delete
- PopLin.Mirror DrugaTocka, PrvaTocka
- Krug.Delete
- Next
| 
