VB.Net vẽ hình mũi tên

[quyenpv 2]

Kính chào anh chị trên diễn đàn

Em có một lisp của bác Lee Mac trên diễn đàn Lisp to draw an arrow thấy rất hay và đúng cái em đang cần, tuy nhiên trình lisp của em =0 và đọc không hiểu. Nhờ anh chị có thể phiên sang vb.net hay c# sử dụng EntityJig (vì em nghĩ thay đổi đổi tượng chỉ có cái này) mới làm được

1. Đây là code lisp của Lee Mac

(defun c:arrow ( / di en gr l1 l2 nm p1 p2 )
   (if
       (and
           (setq p1 (getpoint "\n1st Point: "))
           (setq p2 (getpoint "\n2nd Point: " p1))
       )
       (progn
           (setq di (/ (distance p1 p2) 3.0)
                 nm (trans '(0. 0. 1.) 1 0 t)
           )
           (setq en
               (entget
                   (entmakex
                       (append
                           (list
                              '(0 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              '(100 . "AcDbPolyline")
                              '(90 . 3)
                              '(70 . 0)
                              '(62 . 1) ; <-- Đây là dòng để đặt màu đỏ cho polyline
                           )
                           (setq l1
                               (list
                                   (cons 10 (trans p1 1 nm))
                                   (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm))
                                   (cons 40 (/ di 2.0))
                                  '(41 . 0.0)
                                   (cons 10 (trans p2 1 nm))
                                   (cons 210 nm)
                               )
                           )
                       )
                   )
               )
           )
           (setq l2
               (list
                   (cons 10 (trans p1 1 nm))
                  '(40 . 0.0)
                   (cons 41 (/ di 2.0))
                   (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm))
                   (cons 10 (trans p2 1 nm))
                   (cons 210 nm)
               )
           )
           (setq en (reverse (member (assoc 39 en) (reverse en))))
           (princ "\nChoose Arrow End...")
           (while (= 5 (car (setq gr (grread t 13 0))))
               (entmod
                   (append en
                       (if (< (distance (cadr gr) p2) (distance (cadr gr) p1)) l1 l2)
                   )
               )
           )
       )                    
   )
   (princ)
)

2. Code vb.net của em vọc vạch

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

Public Class ArrowJig
    Inherits EntityJig

    Private _arrowEnd As Point3d

    Public Sub New(entity As Entity, startPt As Point3d)
        MyBase.New(entity)
        _arrowEnd = startPt
    End Sub

    Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
        Dim jppo As New JigPointPromptOptions("\nChọn điểm kết thúc mũi tên:")
        Dim res = prompts.AcquirePoint(jppo)
        If res.Value.Equals(_arrowEnd) Then
            Return SamplerStatus.NoChange
        Else
            _arrowEnd = res.Value
            Return SamplerStatus.OK
        End If
    End Function

    Protected Overrides Function Update() As Boolean
        Dim line As Line = TryCast(Me.Entity, Line)
        If line IsNot Nothing Then
            line.EndPoint = _arrowEnd
        End If
        Return True
    End Function

    Public Shared Sub CreateArrow()
        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        Dim ed = doc.Editor

        Dim ppr = ed.GetPoint("\nChọn điểm bắt đầu mũi tên:")
        If ppr.Status <> PromptStatus.OK Then
            Return
        End If

        Dim line As New Line(ppr.Value, ppr.Value)
        Dim jig As New ArrowJig(line, ppr.Value)
        Dim res = ed.Drag(jig)
        If res.Status = PromptStatus.OK Then
            Using tr = db.TransactionManager.StartTransaction()
                Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                btr.AppendEntity(line)
                tr.AddNewlyCreatedDBObject(line, True)
                tr.Commit()
            End Using
        End If
    End Sub

End Class

 

[Doan Van Ha 3.191]

Biết nó hay và đúng cái đang cần thì cứ thế sử dụng, cần gì phải nhờ 1 người phải biết tới 2 ngôn ngữ để dịch từ tiếng Anh sang tiếng Pháp cho nó phí?

[quyenpv 2]

26 phút trước, Doan Van Ha đã nói:

Biết nó hay và đúng cái đang cần thì cứ thế sử dụng, cần gì phải nhờ 1 người phải biết tới 2 ngôn ngữ để dịch từ tiếng Anh sang tiếng Pháp cho nó phí?

Dạ do chả biết gì về lisp chỉ biết dùng thôi ạ, cái quan trọng em muốn hiểu cách nó thực hiện như thế nào trong vb.net a

[limfx 21]

Cái mũi tên kia bạn định ứng dụng làm gì vậy

 

[cuongtk2 342]

2 giờ trước, limfx đã nói:

Cái mũi tên kia bạn định ứng dụng làm gì vậy

 

Làm cho biết thôi, muốn ứng dụng phải jig leader.

[limfx 21]

Sao không sử dụng Command: leader nhanh tiện hơn a?

[cuongtk2 342]

Command trong net cũng như lisp là thứ ngại dùng, trừ khi mình không viết ra được 1 cái tương tự. Một phần là nó thao tác không trực quan như lệnh gốc. Nữa là ảnh hưởng bởi  osmode.

[quyenpv 2]

6 giờ trước, limfx đã nói:

Cái mũi tên kia bạn định ứng dụng làm gì vậy

 

Trong bản vẽ sơ đồ đấu nối em phải vẽ hướng đi như thế này nên việc đảo chiều mũi tên như lisp trên rất tiện. mà dùng jig thì kiến thức em = 0. Cũng mới làm autocad nên xem diễn đàn có nhưng code thấy rất hay nên đam mê luôn ạ

[cuongtk2 342]

Để làm được điều đó em nên đi theo cách như sau:

1. Lập hàm tạo một block mũi tên riêng biệt bằng 1 pline từ 0,0 đến 10,0  với endwidth = 5

pline.AddVertextAt(0,  new Point2d(0,0), 0, 5 , 0);

pline.AddVertextAt(1,  new Point2d(1,0), 0, 0 , 0);

block.Add(pline);

- lấy ObjectId muiten. 

2. Tạo một leader 

Nhập 2 điểm p1 p2, đặt kiểm tra nếu cần thay đổi vị trí 2 điểm để quay ngược mũi tên

Leader leader = new Leader();

leader.SetDatabaseDefaults();

leader.Dimldrblk = block muiten;

leader.SetVertexAt(0, p1);

leader.SetVertexAt(1, p2);

tuỳ theo scale của style kích thước để đặt 

leader.Dimscale = ??; 

 

[quyenpv 2]

Nếu vẽ thường thì vẫn vẽ được anh

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry

Public Class ArrowCommands
    <CommandMethod("DrawArrow")>
    Public Sub DrawArrow()
        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
            Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

            ' Tạo một polyline cho mũi tên
            Dim arrow As New Polyline()
            arrow.AddVertexAt(0, New Point2d(0, 0), 0, 0, 0) ' Đỉnh dưới
            arrow.AddVertexAt(1, New Point2d(0, 5), 0, 0, 2.5) ' Đỉnh giữa (chỉnh width ở đây để tạo đuôi mũi tên)
            arrow.AddVertexAt(2, New Point2d(0, 10), 0, 0, 0) ' Đỉnh trên

            ' Thêm mũi tên vào model space
            btr.AppendEntity(arrow)
            tr.AddNewlyCreatedDBObject(arrow, True)

            ' Kết thúc giao dịch
            tr.Commit()
        End Using
    End Sub
End Class

[limfx 21]

15 giờ trước, cuongtk2 đã nói:

Command trong net cũng như lisp là thứ ngại dùng, trừ khi mình không viết ra được 1 cái tương tự. Một phần là nó thao tác không trực quan như lệnh gốc. Nữa là ảnh hưởng bởi  osmode.

Cho em hỏi ngoài lề chút a Cuongtk2: Khi mình viết lisp thì tên lệnh ở (defun c:TENLENH () ) có thể trùng tên lệnh máy người xử dụng, vậy làm cách nào để khi load lisp phát hiện trùng tên thì đổi ngay bằng tên lệnh khác như trong Edit Aliases rồi reinit? Thanks!

[cuongtk2 342]

Xem phản hồi của Lý Mặc ở https://stackoverflow.com/questions/51720302/lisp-function-exists-or-not-checking.

 

[ketxu 2.984]

3 giờ trước, limfx đã nói:

Cho em hỏi ngoài lề chút a Cuongtk2: Khi mình viết lisp thì tên lệnh ở (defun c:TENLENH () ) có thể trùng tên lệnh máy người xử dụng, vậy làm cách nào để khi load lisp phát hiện trùng tên thì đổi ngay bằng tên lệnh khác như trong Edit Aliases rồi reinit? Thanks!

Nếu lisp do bạn viết ra thì mình nghĩ có nhiều cách :)
Ví dụ :
 

(defun c:tenratdai()(alert "tenratdai"))
(defun setShortcut(s cmdname)
	(eval (read (strcat "(defun c:" s "()(c:" cmdname "))")))
)
(setq str "Lenhngandi")
(if  (member str lstTenlenh) ; lstShortcut thi lay o Aliasedit ra ha
	(setq str (getstring "ten khac :"))
)
(setShortcut str "tenratdai")

 

[cuongtk2 342]

17 giờ trước, quyenpv đã nói:

Nếu vẽ thường thì vẫn vẽ được anh

Đây là code của nó nha.

DrawArrow.zip

 

[quyenpv 2]

Không anh! Ý em là khi vẽ xong có thể kéo dịch chuyển chiều mũi tên qua lại nên em mới nghĩ chỉ có EntityJig mới làm được kiểu đó ạ

[limfx 21]

8 giờ trước, ketxu đã nói:

Nếu lisp do bạn viết ra thì mình nghĩ có nhiều cách :)
Ví dụ :
 

(defun c:tenratdai()(alert "tenratdai"))
(defun setShortcut(s cmdname)
	(eval (read (strcat "(defun c:" s "()(c:" cmdname "))")))
)
(setq str "Lenhngandi")
(if  (member str lstTenlenh) ; lstShortcut thi lay o Aliasedit ra ha
	(setq str (getstring "ten khac :"))
)
(setShortcut str "tenratdai")

 

Cảm ơn anh đã hướng dẫn

[cuongtk2 342]

5 giờ trước, quyenpv đã nói:

Không anh! Ý em là khi vẽ xong có thể kéo dịch chuyển chiều mũi tên qua lại nên em mới nghĩ chỉ có EntityJig mới làm được kiểu đó ạ

Ừ, tuỳ em thôi. Hãy biến một thứ phức tạp thành đơn giản. Nó sẽ dễ thực hiện hơn rất nhiều.