[討論] scr點資料轉線條分析
2 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論] scr點資料轉線條分析
dear ALL
由於研究工作需要
點資料利用scr需轉回spline
但資料量過大 無法編輯
是否有方式可以減輕資料量可以編輯
卻不會遺失線條 尺寸 等特性
檔案連結如下:
https://mega.co.nz/#!WMYgzZLR!Dr9D92YYub5LFMmNaFpqVFSEr5ZDpCGtZOy_Thxq6YM
使用版本為:2010
請教之
感謝
由於研究工作需要
點資料利用scr需轉回spline
但資料量過大 無法編輯
是否有方式可以減輕資料量可以編輯
卻不會遺失線條 尺寸 等特性
檔案連結如下:
https://mega.co.nz/#!WMYgzZLR!Dr9D92YYub5LFMmNaFpqVFSEr5ZDpCGtZOy_Thxq6YM
使用版本為:2010
請教之
感謝
alex970409- 一般會員
- 文章總數 : 9
年齡 : 41
來自 : 台北
職業 : 研究生
愛好 : 程式設計
個性 : 木訥
使用年資 : 半年
使用版本 : 2010版
積分 : 1
經驗值 : 4879
威望值 : 6
注冊日期 : 2011-07-18
回復: [討論] scr點資料轉線條分析
請勿下載, 嘗試新方法中ing.......... ( 更正, 好像不太對, 我再修正一下....................... ( 參考一下, 圖裏面每一條的點數都不一樣!! ) )
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6714
威望值 : 361
注冊日期 : 2010-09-20
回復: [討論] scr點資料轉線條分析
剩下 16800 點 ( 黃色線 ), 待續!!
15400 點
13200 點
12200 點
LISP程式下載: https://app.box.com/s/0vprf6krc7v6ntoplkcc
15400 點
13200 點
12200 點
LISP程式下載: https://app.box.com/s/0vprf6krc7v6ntoplkcc
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6714
威望值 : 361
注冊日期 : 2010-09-20
回復: [討論] scr點資料轉線條分析
感謝回覆
能減少點數真的很厲害
能減少點數真的很厲害
alex970409- 一般會員
- 文章總數 : 9
年齡 : 41
來自 : 台北
職業 : 研究生
愛好 : 程式設計
個性 : 木訥
使用年資 : 半年
使用版本 : 2010版
積分 : 1
經驗值 : 4879
威望值 : 6
注冊日期 : 2011-07-18
回復: [討論] scr點資料轉線條分析
' 如果有興趣的話可以參考我如何刪除多餘太多太密集的點. 因為太多太密集的點多是在水平線上, 所以一開始我是寫一個
' 連續三個點取出 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
' 連續三個點取出 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
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6714
威望值 : 361
注冊日期 : 2010-09-20
回復: [討論] scr點資料轉線條分析
感謝您的分享
我趕快來試看看
我趕快來試看看
alex970409- 一般會員
- 文章總數 : 9
年齡 : 41
來自 : 台北
職業 : 研究生
愛好 : 程式設計
個性 : 木訥
使用年資 : 半年
使用版本 : 2010版
積分 : 1
經驗值 : 4879
威望值 : 6
注冊日期 : 2011-07-18
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章