HI all,
I want tp place points(place active point) along linestrings and shape elements at given interval. I made the below code, it works but not that fine, takes lot of time also dgn file goes hanging...
can someone tell me how can i improve this one? or is this the way this should done? I am a beginner in this area....
'place points at given interval along the linear elements...'for example if the given interval is 2, then for every 2m a point should be placed on the linestring string from 2 distance...Private Sub cbPlacePoint_Click()Dim ee As ElementEnumeratorDim ele As ElementDim totCnt As Long, idx As Long, stDis As Double, ptInt As Double, leng As DoubleDim pnt As Point3d
'read interval from the user inputptInt = tbInterval.Text
'check for input elements selectionIf ActiveModelReference.AnyElementsSelected = False Then MsgBox "Select linear elements and try again.", vbInformation Exit SubEnd If
On Error GoTo out
Set ee = ActiveModelReference.GetSelectedElementstotCnt = UBound(ee.BuildArrayFromContents) + 1idx = 0ee.Reset
'takes the length of the linear elements to repeat point placing....Do While ee.MoveNext Set ele = ee.Current 'start point distance also same as interval distance... stDis = ptInt If ele.IsLineElement Or ele.IsShapeElement Or ele.IsComplexShapeElement Or ele.IsComplexStringElement Then If ele.IsLineElement Then leng = ele.AsLineElement.Length ElseIf ele.IsShapeElement Then leng = ele.AsShapeElement.Perimeter ElseIf ele.IsComplexShapeElement Then leng = ele.AsComplexShapeElement.Perimeter ElseIf ele.IsComplexStringElement Then leng = ele.AsComplexStringElement.Length End If 'loop until start distance exceeds the length... Do While stDis < leng pnt = ele.AsLineElement.PointAtDistance(stDis) With CadInputQueue .SendCommand "PLACE POINT" .SendDataPoint pnt, 1 .SendReset End With CommandState.StartDefaultCommand stDis = stDis + ptInt Loop End If idx = idx + 1 ShowCommand "placing points at interval" ShowStatus "processing...." & idx & "/" & totCnt Loop
ShowCommand ""ShowStatus ""CommandState.LastView.RedrawMe.HideMsgBox "completed", vbInformation
out:MsgBox Err.Description, vbCritical, "Error"
End Sub
Thanks in advance...
Hello,
it is faster to create the LineElement per code than per Command:
'place points at given interval along the linear elements... 'for example if the given interval is 2, then for every 2m a point should be placed on the linestring string from 2 distance... Dim ee As ElementEnumerator Dim ele As Element Dim totCnt As Long, idx As Long, stDis As Double, ptInt As Double, leng As Double Dim pnt As Point3d Dim line As LineElement 'read interval from the user input ptInt = tbInterval.Text 'check for input elements selection If ActiveModelReference.AnyElementsSelected = False Then MsgBox "Select linear elements and try again.", vbInformation Exit Sub End If On Error GoTo out Set ee = ActiveModelReference.GetSelectedElements totCnt = UBound(ee.BuildArrayFromContents) + 1 idx = 0 ee.Reset 'takes the length of the linear elements to repeat point placing.... Do While ee.MoveNext Set ele = ee.Current 'start point distance also same as interval distance... stDis = ptInt If ele.IsLineElement Or ele.IsShapeElement Or ele.IsComplexShapeElement Or ele.IsComplexStringElement Then If ele.IsLineElement Then leng = ele.AsLineElement.Length ElseIf ele.IsShapeElement Then leng = ele.AsShapeElement.Perimeter ElseIf ele.IsComplexShapeElement Then leng = ele.AsComplexShapeElement.Perimeter ElseIf ele.IsComplexStringElement Then leng = ele.AsComplexStringElement.Length End If 'loop until start distance exceeds the length... Do While stDis < leng pnt = ele.AsLineElement.PointAtDistance(stDis) Set line = CreateLineElement2(Nothing, pnt, pnt) ActiveModelReference.AddElement line stDis = stDis + ptInt Loop End If idx = idx + 1 ShowCommand "placing points at interval" ShowStatus "processing...." & idx & "/" & totCnt Loop ShowCommand "" ShowStatus "" CommandState.LastView.Redraw Me.Hide MsgBox "completed", vbInformation Exit Sub out: MsgBox Err.Description, vbCritical, "Error"
HTH
Martin