Đến nội dung


Hình ảnh
- - - - -

Xóa bớt đỉnh


  • Please log in to reply
29 replies to this topic

#21 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 10 January 2014 - 01:46 PM

Lisp chạy tốt. Tuy nhiên mình đề nghị bổ sung thêm tính năng "Diet" (giảm béo) cho PLine. Nghĩa là cho phép xóa bớt đỉnh của PLine trong một điều kiện nào đó, ví dụ như góc tạo bởi 3 đỉnh liên tiếp lớn hơn 175độ (nó gần như thẳng hàng).

Hề hề hề,

Việc giảm béo này không qua khó và không cần bổ sung gì thêm, chỉ cần sửa một chút ở điều kiện kiểm tra để loại trừ đỉnh. Thay vì dùng (equal ang1 ang2  0.0000001) ta dùng (equal ang1 ang2 5) bác ạ. Bác thử test lại xem đã ưng ý chưa nhé.

 

 Lưu ý khẩn: Sorry all, Mình nhầm chút xíu. vì hàm (angle p1 p2) trả về đơn vị đo góc là radian chứ không phải độ. Do vậy viết (equal ang1 ang2 5) sẽ cho ra kết quả sai với yêu cầu. Phải sửa lại là (equal ang1 ang2 (/ 5 180))

Rất mong mọi người tha thứ vì tội cẩu thả, nhanh nhảu đoảng........


  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#22 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 16 January 2014 - 01:40 PM

Chào các bạn,

Sau khi mình tham khảo code của các bạn. Thì mình có viết lại và đã xóa được các đỉnh ở các đoạn thẳng nhưng không hiểu sao cái cung mình làm hoài không được. Các bạn giúp mình chỗ này với. Hic.

<CommandMethod("PLineOptimize")> Public Sub PLineOptimize()
        Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim flag As Boolean = False
        Dim opts As PromptEntityOptions = New PromptEntityOptions("\nSelect a Polyline: ")
        opts.SetRejectMessage("Not a Polyline.")
        ' opts.AddAllowedClass(typeof(Polyline), true)
        Dim per As PromptEntityResult = ed.GetEntity(opts)
        If (per.Status <> PromptStatus.OK) Then
            Return
        End If
        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Dim pl As Polyline = TryCast(tr.GetObject(per.ObjectId, OpenMode.ForRead), Polyline)
            Dim pline As Polyline = TryCast(pl.Clone(), Polyline)
            Dim lastIndex As Integer = pline.NumberOfVertices - 1
            Dim bul1 As Double
            Dim bul2 As Double
            Dim tempi As Integer
            Dim sta As Point2d
            Dim mid As Point2d
            Dim endd As Point2d
            Dim j As Integer = 0
            While j < lastIndex
                j = 0
                For i As Integer = 0 To lastIndex
                    If (i = lastIndex) Then
                        Exit For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i)) Then
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i + 1) <> pline.GetEndWidthAt(i + 1)) Then
                        i += 1
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i + 1)) Then
                        Continue For
                    End If
                    bul1 = pline.GetBulgeAt(i)
                    bul2 = pline.GetBulgeAt(i + 1)
                    If (bul1 <> 0) Then '' Arc
                        '' 
                        If (bul2 <> 0) Then

                            Dim circu1 As CircularArc2d = pline.GetArcSegment2dAt(i)
                            Dim circu2 As CircularArc2d = pline.GetArcSegment2dAt(i + 1)
                            Dim bugle As Double = Math.Tan(circu1.StartAngle / 2.0)
                            pline.RemoveVertexAt(i + 1)
                            pline.AddVertexAt(i, New Point2d(circu1.StartPoint.X, circu1.StartPoint.Y), bugle, 0, 0)
                            pline.SetPointAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y))

                            ' pline.AddVertexAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y), 0, 0, 0)
                            '  Dim L As Double = 0.5 * (2 * circu1.Radius)
                            ' Dim bugle As Double = (circu1.Radius - Math.Sqrt(circu1.Radius * circu1.Radius - L * L)) / L
                            ' pline.AddVertexAt(i + 2, pline.GetPoint2dAt(i + 2), pline.GetBulgeAt(i + 2), 0.0, 0.0)
                            '  pline.SetPointAt(i, pline.GetPoint2dAt(i))


                            '  pline.RemoveVertexAt(i + 2)
                            i -= 1
                            lastIndex -= 1
                            j -= 1
                            Continue For
                        End If
                    Else '' Line
                        If (bul2 = 0) Then

                            If (i + 2 <= lastIndex And tempi = 0) Then
                                sta = pline.GetPoint2dAt(i)
                                mid = pline.GetPoint2dAt(i + 1)
                                endd = pline.GetPoint2dAt(i + 2)
                                If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                    pline.RemoveVertexAt(i + 1)
                                    i -= 1
                                    lastIndex -= 1
                                    j -= 1
                                    Continue For
                                End If
                            Else
                                If (tempi = 0) Then
                                    tempi = i
                                    Exit For
                                ElseIf (tempi < lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(tempi + 1)
                                    endd = pline.GetPoint2dAt(i)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(tempi + 1)
                                        lastIndex -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi = lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(i)
                                    endd = pline.GetPoint2dAt(i + 1)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(i)
                                        lastIndex -= 1
                                        i -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi > lastIndex) Then
                                    tempi = 0
                                End If
                            End If
                        End If
                    End If
                    j += 1
                Next
            End While
            If (pline.NumberOfVertices < pl.NumberOfVertices) Then
                Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                pline.SetDatabaseDefaults()
                pline.ColorIndex = 6
                btr.AppendEntity(pline)
                tr.AddNewlyCreatedDBObject(pline, True)
                tr.Commit()
            Else
                ed.WriteMessage("Nothing to Optimize.")
            End If
        End Using
    End Sub

Và đây là hình mình muốn xóa bớt đỉnh.

http://www.cadviet.c.../125141_arc.dwg


  • 0

#23 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 16 January 2014 - 04:29 PM

Chào các bạn,

Sau khi mình tham khảo code của các bạn. Thì mình có viết lại và đã xóa được các đỉnh ở các đoạn thẳng nhưng không hiểu sao cái cung mình làm hoài không được. Các bạn giúp mình chỗ này với. Hic.

<CommandMethod("PLineOptimize")> Public Sub PLineOptimize()
        Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim flag As Boolean = False
        Dim opts As PromptEntityOptions = New PromptEntityOptions("\nSelect a Polyline: ")
        opts.SetRejectMessage("Not a Polyline.")
        ' opts.AddAllowedClass(typeof(Polyline), true)
        Dim per As PromptEntityResult = ed.GetEntity(opts)
        If (per.Status <> PromptStatus.OK) Then
            Return
        End If
        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Dim pl As Polyline = TryCast(tr.GetObject(per.ObjectId, OpenMode.ForRead), Polyline)
            Dim pline As Polyline = TryCast(pl.Clone(), Polyline)
            Dim lastIndex As Integer = pline.NumberOfVertices - 1
            Dim bul1 As Double
            Dim bul2 As Double
            Dim tempi As Integer
            Dim sta As Point2d
            Dim mid As Point2d
            Dim endd As Point2d
            Dim j As Integer = 0
            While j < lastIndex
                j = 0
                For i As Integer = 0 To lastIndex
                    If (i = lastIndex) Then
                        Exit For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i)) Then
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i + 1) <> pline.GetEndWidthAt(i + 1)) Then
                        i += 1
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i + 1)) Then
                        Continue For
                    End If
                    bul1 = pline.GetBulgeAt(i)
                    bul2 = pline.GetBulgeAt(i + 1)
                    If (bul1 <> 0) Then '' Arc
                        '' 
                        If (bul2 <> 0) Then

                            Dim circu1 As CircularArc2d = pline.GetArcSegment2dAt(i)
                            Dim circu2 As CircularArc2d = pline.GetArcSegment2dAt(i + 1)
                            Dim bugle As Double = Math.Tan(circu1.StartAngle / 2.0)
                            pline.RemoveVertexAt(i + 1)
                            pline.AddVertexAt(i, New Point2d(circu1.StartPoint.X, circu1.StartPoint.Y), bugle, 0, 0)
                            pline.SetPointAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y))

                            ' pline.AddVertexAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y), 0, 0, 0)
                            '  Dim L As Double = 0.5 * (2 * circu1.Radius)
                            ' Dim bugle As Double = (circu1.Radius - Math.Sqrt(circu1.Radius * circu1.Radius - L * L)) / L
                            ' pline.AddVertexAt(i + 2, pline.GetPoint2dAt(i + 2), pline.GetBulgeAt(i + 2), 0.0, 0.0)
                            '  pline.SetPointAt(i, pline.GetPoint2dAt(i))


                            '  pline.RemoveVertexAt(i + 2)
                            i -= 1
                            lastIndex -= 1
                            j -= 1
                            Continue For
                        End If
                    Else '' Line
                        If (bul2 = 0) Then

                            If (i + 2 <= lastIndex And tempi = 0) Then
                                sta = pline.GetPoint2dAt(i)
                                mid = pline.GetPoint2dAt(i + 1)
                                endd = pline.GetPoint2dAt(i + 2)
                                If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                    pline.RemoveVertexAt(i + 1)
                                    i -= 1
                                    lastIndex -= 1
                                    j -= 1
                                    Continue For
                                End If
                            Else
                                If (tempi = 0) Then
                                    tempi = i
                                    Exit For
                                ElseIf (tempi < lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(tempi + 1)
                                    endd = pline.GetPoint2dAt(i)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(tempi + 1)
                                        lastIndex -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi = lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(i)
                                    endd = pline.GetPoint2dAt(i + 1)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(i)
                                        lastIndex -= 1
                                        i -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi > lastIndex) Then
                                    tempi = 0
                                End If
                            End If
                        End If
                    End If
                    j += 1
                Next
            End While
            If (pline.NumberOfVertices < pl.NumberOfVertices) Then
                Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                pline.SetDatabaseDefaults()
                pline.ColorIndex = 6
                btr.AppendEntity(pline)
                tr.AddNewlyCreatedDBObject(pline, True)
                tr.Commit()
            Else
                ed.WriteMessage("Nothing to Optimize.")
            End If
        End Using
    End Sub

Và đây là hình mình muốn xóa bớt đỉnh.

http://www.cadviet.c.../125141_arc.dwg

Hề hề hề,

Mình không hiểu nhiều về VB nên đọc code của bạn cũng như điếc vậy.

Nhưng mình nghĩ dù là VB hay VA thì để làm được việc xóa đỉnh đối với cung tròn này cũng cần phải có các việc phải làm là:

1/- kiểm tra số bulge tại các đỉnh. Nếu số bulge ở hai đỉnh liên tiếp cùng khác 0 thì chuyển sang bước kiểm tra tiếp theo.

2/- Tính toán bán kinh vá xác dịnh tâm của hai cung xuất phát từ hai đỉnh này.Kiểm tra xem nếu cả hai yếu tố này đều trùng nhau thì mới thực hiện xóa đỉnh thứ hai đi.

3/- sau khi xóa phải thực hiện việc nối lại cung trên cơ sở bán kính và tâm đã xác định ở bước trên, tọa độ của điểm bát đầu cung thứ nhất và điểm chót của cung thứ hai. (tức là phải thay đổi số bulge của cung thứ nhất thành số bule của cung mới cần tạo)

 

Với trường hợp có nhiều cung nối tiếp nhau thì thay điểm chót của cung thứ hai bằng điểm chót của cung cuối cùng trong số các cung này.

 

Bạn thử kiểm tra lại trong code của bạn đã thực hiện đủ các bước như trên chưa nhé.

mình đã chéck với bản vẽ của bạn thì cả hai líp mình gửi trên topic này đều chạy ngon bạn ạ. Có nghĩa là cách suy lận của mình không quá sai đâu.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#24 Polyline

Polyline

    biết lệnh mirror

  • Members
  • PipPipPip
  • 159 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 16 January 2014 - 04:37 PM

... Thay vì dùng (equal ang1 ang2  0.0000001) ... sửa lại là (equal ang1 ang2 (/ 5 180))

Mình đã thử thay số 0.0000001 bằng (/ 5 180) ở các dòng 43, 51, 52 và 65 nhưng không thực hiện được. Bác kiểm tra lại giúp nhé!


  • 0

#25 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 16 January 2014 - 04:53 PM

Ok. mình đã làm được. Mình xin cảm ơn các bạn đã quan tâm.


  • 0

#26 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 16 January 2014 - 10:07 PM

Mình đã thử thay số 0.0000001 bằng (/ 5 180) ở các dòng 43, 51, 52 và 65 nhưng không thực hiện được. Bác kiểm tra lại giúp nhé!

Hề hề hề,

Mình chưa hiểu bác thay ở những dòng nói trên trong lisp là vì sao bởi thực tế trong lisp chỉ có duy nhất một dòng code có chứa (equal ang1  ang2  0.0000001)

các dòng khác tuy có chứa (equal ....0.0000001) nhưng đối số của nó không phải là góc đâu nên sử dụng tham số (5/180) đâu có được bởi yêu cầu các đối số này phải trùng nhau gần như hoàn toàn cơ mà.

Bác thử check lại xem nhé.


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#27 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 17 January 2014 - 08:45 AM

Hề hề hề,

Mình chưa hiểu bác thay ở những dòng nói trên trong lisp là vì sao bởi thực tế trong lisp chỉ có duy nhất một dòng code có chứa (equal ang1  ang2  0.0000001)

các dòng khác tuy có chứa (equal ....0.0000001) nhưng đối số của nó không phải là góc đâu nên sử dụng tham số (5/180) đâu có được bởi yêu cầu các đối số này phải trùng nhau gần như hoàn toàn cơ mà.

Bác thử check lại xem nhé.

2 góc chênh nhau 5/180 có thể chênh 2Pi  - 5/180 -> 2Pi

 

(or (equal ang1  ang2  saiso) (equal (* 2 pi) (abs (- ang1  ang2)) saiso))


  • 1

#28 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 17 January 2014 - 09:10 AM

(/ 5 180) >> 0


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#29 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 17 January 2014 - 02:51 PM

(/ 5 180) >> 0

Hề hề hề,
Quên béng mất cái vụ phép chia có đối số là các số nguyên. Sorry các bác. Cần đổi lại là (/ 5.0 180)

PS: Kết hợp với sự hướng dẫn của bác ndtnv phải sửa đoạn code (equal ang1 ang2 0.0000001) thành:
(or (equal ang1 ang2 (* pi (/ 5.0 180))) (equal (* 2 pi) (abs (- ang1 ang2)) (* 2 pi) (abs (- ang1 ang2)) (* pi (/ 5.0 180))))

Rất mong các bác tha lỗi vì cái sự kém hiểu biết nên đã nhầm lẫn và không xét hết các trường hợp.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#30 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 03 April 2014 - 04:36 PM

Cái lisp giảm béo của bác Bình phải bổ sung thế nào nữa để thêm chức năng giảm béo khi cạnh nhỏ hơn 1 giá trị nhập vào các bác nhỉ ?!

(mới biết đc mấy chữ mà gặp mấy anh Lisp quá "hầm hố" nên ko dám sửa :D  

Vì mình đang cần gấp nó cho công việc mà tự sửa dẫn đến sai thì công sức đi toi ! Mong đc giúp đỡ)

Thanks !


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson