[討論] scr點資料轉線條分析

dear ALL

由於研究工作需要

點資料利用scr需轉回spline

但資料量過大 無法編輯

是否有方式可以減輕資料量可以編輯

卻不會遺失線條 尺寸 等特性

檔案連結如下:
https://mega.co.nz/#!WMYgzZLR!Dr9D92YYub5LFMmNaFpqVFSEr5ZDpCGtZOy_Thxq6YM

使用版本為：2010

請教之

感謝

請勿下載, 嘗試新方法中ing.......... ( 更正, 好像不太對, 我再修正一下....................... ( 參考一下, 圖裏面每一條的點數都不一樣!! ) )

剩下 16800 點 ( 黃色線 ), 待續!!

15400 點

13200 點

12200 點

LISP程式下載： https://app.box.com/s/0vprf6krc7v6ntoplkcc

感謝回覆
能減少點數真的很厲害

' 如果有興趣的話可以參考我如何刪除多餘太多太密集的點. 因為太多太密集的點多是在水平線上, 所以一開始我是寫一個
' 連續三個點取出 Y 座標, 再計算三點是不是呈水平線, 如果是那就可以刪除中間的點. 一開始我是半自動半手動一段一段
' 慢慢刪除. 後來處理很久覺得太慢了, 就寫了以下長一點的程式, 可以全自動從頭跑到尾. 這個程式跑一次會刪除一些點,
' 所以可以跑很多次, 但後來雲線就會開始變形, 差多不剩 10,000 點的時後連水平線都變彎曲了, 所以要跑幾次看你了,
' 參考一下, 有興趣可以學學 Autolisp, VBA, VB.Net. ObjectARX 都可以!! thanks
Public tm As AcadModelSpace
Public tu As AcadUtility

Option Explicit

Public Sub test()

On Error Resume Next

Const pi = 3.141592 / 180 ' const : 設定常數 pi

Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility

' ***********************************************************************
Dim spline_obj As AcadSpline ' 設定雲線變數
Dim i_count As Integer ' 設定整數變數
Dim first_p As Variant ' 設定座標變數
Dim text_obj As AcadText ' 設定文字變數
Dim d_count As Integer
Dim second_p As Variant
Dim third_p As Variant
Dim fourth_p As Variant
Dim fifth_p As Variant
Dim text_obj_2 As AcadText
Dim text_obj_3 As AcadText
Dim text_obj_4 As AcadText
Dim text_obj_5 As AcadText

' 輸入雲線的 handle "21e", 就可以轉換到雲線物件. handle 用 list 點雲線
' 就可以看的到!!

Set spline_obj = ThisDrawing.HandleToObject("21e")

' NumberOfFitPoints 得到整條雲線總共有幾個點
For i_count = 1 To spline_obj.NumberOfFitPoints

    ' 因為一直刪除雲線的點, 所以點會一直減少, i_count 要提前結束跳出迴圈
    If i_count > spline_obj.NumberOfFitPoints - 5 Then Exit For
   
    ' 讓執行程式時, 可以在命令列看到執行到第幾個點
    tu.Prompt " 執行 " & i_count & " .........................."

    first_p = spline_obj.GetFitPoint(i_count) ' 抓雲線的點資料
    second_p = spline_obj.GetFitPoint(i_count + 1)
    third_p = spline_obj.GetFitPoint(i_count + 2)
    fourth_p = spline_obj.GetFitPoint(i_count + 3)
    fifth_p = spline_obj.GetFitPoint(i_count + 4)
          
    ' 在上面寫上第幾點的數字, 執行可以看到計算到第幾點了!!
    Set text_obj = tm.AddText(i_count, first_p, 2 * 1 / 10 ^ 4)
    Set text_obj_2 = tm.AddText(i_count + 1, second_p, 2 * 1 / 10 ^ 4)
    Set text_obj_3 = tm.AddText(i_count + 2, third_p, 2 * 1 / 10 ^ 4)
    Set text_obj_4 = tm.AddText(i_count + 3, fourth_p, 2 * 1 / 10 ^ 4)
    Set text_obj_5 = tm.AddText(i_count + 4, fifth_p, 2 * 1 / 10 ^ 4)
          
    ZoomWindow first_p, fifth_p ' 把計算的地方局部放大
    ZoomCenter third_p, 0.05
       
    ' 因為點太多太密集的地方多在水平線, 所以程式主要是抓連續 5 個點的 Y 座標,
    ' 來計算. 如果 5 個點的高度都差很小, 那就是連續水平, 所以就刪除第三點.
    ' 如果計算起來 5 個點不是連續的水平線, 那就不會刪除點. 所以也不會改變
    ' 其它不是水平的形狀, 希望最後計算出來沒有改變太多.
    If Abs(first_p(1) - second_p(1)) < 1 / 10 ^ 8 And _
        Abs(second_p(1) - third_p(1)) < 1 / 10 ^ 8 And _
           Abs(third_p(1) - fourth_p(1)) < 1 / 10 ^ 8 And _
             Abs(fourth_p(1) - fifth_p(1)) < 1 / 10 ^ 8 Then
            
       text_obj.color = 1: text_obj.Update
      
       spline_obj.DeleteFitPoint i_count + 2 ' 刪除第三點
      
       ThisDrawing.Regen True
    End If
   
    text_obj.Delete: text_obj_2.Delete: text_obj_3.Delete ' 刪除寫的文字
    text_obj_4.Delete: text_obj_5.Delete
Next i_count

ThisDrawing.Regen True

MsgBox " 計算完成剩下 " & spline_obj.NumberOfFitPoints & " 個點!!"

End Sub

感謝您的分享
我趕快來試看看