Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

[thanhduan2407 280]

9 giờ trước, Doan Van Ha đã nói:

Nếu tôi nhớ không nhầm thì cách vẽ lưới tam giác TIN của tay người Nga đã xét yếu tố <= Amax rồi mà?

Cháu vẽ đường đồng mức nó không được cong trơn lắm nên cháu vẽ bằng phần mềm khác bác ạ. Hiện tại cháu vẫn sử dụng mô hình TIN rồi lấy đường boundary đó rồi cho vào phần mềm khác chạy. 

Mặt khác. Cháu cũng muốn dựa vào thuật toán này để tính diện tích đo được trong một ngày mà không cần phải bo bằng tay.

[anhGeodesy 2]

Vào lúc 17/3/2019 tại 08:45, thanhduan2407 đã nói:

Cháu vẽ đường đồng mức nó không được cong trơn lắm nên cháu vẽ bằng phần mềm khác bác ạ. Hiện tại cháu vẫn sử dụng mô hình TIN rồi lấy đường boundary đó rồi cho vào phần mềm khác chạy. 

Mặt khác. Cháu cũng muốn dựa vào thuật toán này để tính diện tích đo được trong một ngày mà không cần phải bo bằng tay.

@thanhduan2407 Bạn thử nghiên cứu viết theo phương pháp này nhé !

https://vnoi.info/wiki/translate/wcipeg/Convex-Hull

[Doan Van Ha 3212]

Thanhduan2407 ơi! Bài toán này có thể có nhiều nghiệm nhé!

[thanhduan2407 280]

3 giờ trước, Doan Van Ha đã nói:

Thanhduan2407 ơi! Bài toán này có thể có nhiều nghiệm nhé!

Dạ. Có nhiều nghiệm thì sẽ tách thành nhiều đường bao sao cho thỏa mãn đầu bài. Giống như co cụm từng đống rơm ạ. 

[Doan Van Ha 3212]

11 giờ trước, thanhduan2407 đã nói:

Dạ. Có nhiều nghiệm thì sẽ tách thành nhiều đường bao sao cho thỏa mãn đầu bài. Giống như co cụm từng đống rơm ạ. 

Không hiểu ý rồi. Nhiều nghiệm nhưng vẫn là 1 đống. Tức là có nhiều cách gom tập điểm trong chỉ 1 đường bao, các đường bao này đều thỏa đề bài.

Xem ví dụ:

Thành Duân.dwg

[thanhduan2407 280]

Vào lúc 21/3/2019 tại 08:24, Doan Van Ha đã nói:

Không hiểu ý rồi. Nhiều nghiệm nhưng vẫn là 1 đống. Tức là có nhiều cách gom tập điểm trong chỉ 1 đường bao, các đường bao này đều thỏa đề bài.

Xem ví dụ:

Thành Duân.dwg

Mấy nay cháu bận đi làm quá nên chưa trả lời bác được. Có thể cháu nói chưa hết ý và mục đích của mình. Cảm ơn bác đã quan tâm ạ.

[Doan Van Ha 3212]

Đáng được nhận 1 dislike cho tội nửa vời.

[Duong Nhat Duy 484]

Các bạn cho mình hỏi, mình có 1 hàm, ví dụ:

(defun C:zz () (print "Hello") (print))

 

Bây giờ mình muốn gọi hàm trên bằng các lệnh khác nhau ví dụ: xx, cc, vv, ... thì có cách nào viết gom nó vào được ko, trước h mình toàn làm thủ công kiểu:

(defun C:xx () (C:zz) (print))

(defun C:vv () (C:zz) (print))

...

 

Mình cảm ơn nhé !

[Doan Van Ha 3212]

9 giờ trước, Duong Nhat Duy đã nói:

Các bạn cho mình hỏi, mình có 1 hàm, ví dụ:

(defun C:zz () (print "Hello") (print))

Bây giờ mình muốn gọi hàm trên bằng các lệnh khác nhau ví dụ: xx, cc, vv, ... thì có cách nào viết gom nó vào được ko, trước h mình toàn làm thủ công kiểu:

(defun C:xx () (C:zz) (print))

(defun C:vv () (C:zz) (print))

...

Mình cảm ơn nhé !

(defun C:ZZ () (print "Hello") (print))
(mapcar '(lambda(x) (vlax-add-cmd x 'C:ZZ)) (list "AA" "BB" "CC")) 

[Duong Nhat Duy 484]

Cảm ơn bạn nhé !

[thanhduan2407 280]

[Hỏi hàm Gread]

Em đã có sẵn 1 selection (ssBang) với Base Point là PntDat

Em muốn move ssBang hiển thị theo kiểu di chuột cho đến khi click chuột phải thì dừng tại đó.

Em viết như này mà vẫn chưa được. Mong các bác chỉ giáo em với.

(TD:vla-move-ss ssBang PntDat (setq pt (cadr (grread t 13 0))))
(setq flag T)
(while (and flag (= 5 (car (setq gr (grread t 13 0)))))
      (progn
     (redraw)
     (setq Pt1 (cadr gr))
     (TD:vla-move-ss ssBang pt1 (cadr (grread t 13 0)))
       )
      (if (= 3 (car gr))
       (setq flag nil)
      )
 )


(defun CV:List-to-ss (lst / ss)
  (setq ss (ssadd))
  (foreach item	lst
    (or	(= (type item) 'Ename)
	(setq item (vlax-vla-object->ename item))
    )
    (setq ss (ssadd item ss))
  )
  ss
)

 

[Doan Van Ha 3212]

Dễ mà. Muốn move từ A đến các điểm grread B, C, D... thì copy từ A đến B, rồi xóa nó, rồi copy từ A đến C, rồi xóa nó, rồi copy từ A đến D... Sau cùng xóa A.

[thanhduan2407 280]

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

Dễ mà. Muốn move từ A đến các điểm grread B, C, D... thì copy từ A đến B, rồi xóa nó, rồi copy từ A đến C, rồi xóa nó, rồi copy từ A đến D... Sau cùng xóa A.

mong bác chỉ giáo cháu thêm với ạ. Cháu sai phương thức chỗ nào đó mà không mần ra dc.

[thanhduan2407 280]

Cháu được hỗ trợ làm được rồi bác ạ.

 

  (TD:vla-move-ss ssBang PntDat (setq p (cadr (grread t 15 3))))
  (while
     (if (and (setq gr (grread t 15 3)) (eq (car gr) 5))
      (TD:vla-move-ss ssBang p (setq p (cadr gr)))
      (if (eq (car gr) 3)
	nil
      )
     )
  )

 

[Doan Van Ha 3212]

Cái này?

(defun C:TD(/ ss lst p1 gr code p2)
 (setq ss (ssget) lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) p1 (getpoint "\nChon diem chuan: "))
 (while (and (setq gr (grread T 4 0) code (car gr) p2 (cadr gr)) (not (= 3 code)) (not (= 25 code)))
  (cond
;----- TH1. Khi rª chuét trªn mµn h×nh.
   ((= 5 code) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst) (setq p1 p2))
;----- TH2. Khi pick point hoÆc chuét ph¶i.
   ((or (= 3 code) (= 25 code)) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst))))
 (princ))

[huunhantvxdts 196]

18 giờ trước, Doan Van Ha đã nói:

Cái này?

 

• td.lsp
  
• [✎]
   

(defun C:TD(/ ss lst p1 gr code p2)
 (setq ss (ssget) lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) p1 (getpoint "\nChon diem chuan: "))
 (while (and (setq gr (grread T 4 0) code (car gr) p2 (cadr gr)) (not (= 3 code)) (not (= 25 code)))
  (cond
;----- TH1. Khi rª chuét trªn mµn h×nh.
   ((= 5 code) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst) (setq p1 p2))
;----- TH2. Khi pick point hoÆc chuét ph¶i.
   ((or (= 3 code) (= 25 code)) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst))))
 (princ))

 

Cái này của bác làm sao có thêm bắt điểm nữa thì hay nhỉ

[Doan Van Ha 3212]

6 phút trước, huunhantvxdts đã nói:

Cái này của bác làm sao có thêm bắt điểm nữa thì hay nhỉ

Anh này ElpanovEvgeniy có osnap cho grread nè. Dài lắm

[DuongTrungHuy 138]

Vào lúc 17/3/2019 tại 08:45, thanhduan2407 đã nói:

Cháu vẽ đường đồng mức nó không được cong trơn lắm nên cháu vẽ bằng phần mềm khác bác ạ. Hiện tại cháu vẫn sử dụng mô hình TIN rồi lấy đường boundary đó rồi cho vào phần mềm khác chạy. 

Mặt khác. Cháu cũng muốn dựa vào thuật toán này để tính diện tích đo được trong một ngày mà không cần phải bo bằng tay.

Bạn có thể vẽ Spline qua các điểm dó xong lại xuất Spline đó thành Poly cho đẹp.

[thanhduan2407 280]

Vào lúc 3/4/2019 tại 14:14, Doan Van Ha đã nói:

Cái này?

 

• td.lsp
  
• [✎]
   

(defun C:TD(/ ss lst p1 gr code p2)
 (setq ss (ssget) lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) p1 (getpoint "\nChon diem chuan: "))
 (while (and (setq gr (grread T 4 0) code (car gr) p2 (cadr gr)) (not (= 3 code)) (not (= 25 code)))
  (cond
;----- TH1. Khi rª chuét trªn mµn h×nh.
   ((= 5 code) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst) (setq p1 p2))
;----- TH2. Khi pick point hoÆc chuét ph¶i.
   ((or (= 3 code) (= 25 code)) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst))))
 (princ))

 

Cháu cảm ơn bác Ha nhiều! Code mượt và dễ hiểu lắm ạ

[thanhduan2407 280]

4 giờ trước, DuongTrungHuy đã nói:

Bạn có thể vẽ Spline qua các điểm dó xong lại xuất Spline đó thành Poly cho đẹp.

 

Nếu spline đẹp rồi thì cần gì cho nó thành Polyline nữa?

[DuongTrungHuy 138]

13 giờ trước, thanhduan2407 đã nói:

 

Nếu spline đẹp rồi thì cần gì cho nó thành Polyline nữa?

Cái đường Spline đẹp nhưng đôi khi bất tiện Bạn à. Bạn chỉ cần di chuyển 1 đỉnh (vì 1 lý do nào đó cần dịch chuyển) thì nó chỉnh luôn tòan bộ. Đường đồng mức trong khảo sát khi vẽ xong cần chỉnh cho phù hợp từng đỉnh lúc đó đường Poly lại tốt hơn. Một đôi khi mình dùng đường cong Bezier để vẽ đồng mức thành Poly qua 1 số điểm cho trước.

[Hungdung123 2]

CÁC BÁC XEM CHO EM LISP NÀY CÒN THIỀU GÌ KO MÀ E CHẠY KO RA ĐƯỢC Ạ! E CẢM ƠN

(defun c:tt  (/ Line Polyline cmd col l-tmp lay lpn lpr lpt lsp lst-dc lst-ent lst-ptn lst-tn pgl pgr pl-tn pr1 pt1 ptl ptr ss pxl pxr)
 (defun Line  (p1 p2)
  (entmakex (list (cons 0 "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)))))
 (defun Polyline  (lst col lay)
  (entmakex (list (cons 0 "POLYLINE") (cons 62 col) (cons 8 lay) (cons 10 '(0 0 0))))
  (mapcar (function (lambda (p) (entmake (list (cons 0 "VERTEX") (cons 10 (trans p 1 0)))))) lst)
  (entmakex (list (cons 0 "SEQEND"))))
 (setq cmd (getvar 'CMDECHO))
 (setvar 'CMDECHO 0)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (setq ss (ssget '((0 . "*POLYLINE") (8 . "PLINEDIACHATTN,PLINETNTN"))))
          (setq ptl (getpoint "\nDiem ben trai: "))
          (setq ptr (getpoint "\nDiem ben phai: ")))
  (progn (setq lst-ent (acet-ss-to-list ss))
         (foreach x  lst-ent
          (if (wcmatch (cdr (assoc 8 (entget x))) "PLINETNTN")
           (progn (setq lpn   (acet-geom-vertex-list x)
                        lpn   (vl-remove-if-not '(lambda (x) (< (car ptl) (car x) (car ptr))) lpn)
                        pl-tn x)
                  (setq lst-tn (cons lpn lst-tn)))
           (setq lst-dc (cons x lst-dc))))
         (foreach x  lst-dc
          (if (wcmatch (cdr (assoc 8 (entget x))) "PLINEDIACHATTN")
           (progn (setq lsp (acet-geom-vertex-list x)
                        els (vl-remove-if '(lambda (x) (member x '(-1 5))) (entget x))
                        lpt (vl-remove-if '(lambda (x) (> (car x) (car ptl))) lsp)
                        pt1 (car (cdr (reverse lpt)))
                        lpr (vl-remove-if '(lambda (x) (< (car x) (car ptr))) lsp)
                        pr1 (cadr lpr)
                        lay (cdr (assoc 8 (entget x)))
                        col (cdr (assoc 62 (entget x))))
                  (or col (setq col 256))
                  (setq l-tmp (line pt1 (last lpt))
                        pgl   (acet-geom-intersectwith l-tmp pl-tn 1)
                        pgl   (vl-remove-if '(lambda (x) (> (cadr x) (cadr (trans ptl 1 0)))) pgl))
                  (and pgl (setq pgl (trans (car pgl) 0 1)))
                  (entdel l-tmp)
                  (setq l-tmp (line pr1 (car lpr))
                        pgr   (acet-geom-intersectwith l-tmp pl-tn 1)
                        pgr   (vl-remove-if '(lambda (x) (> (cadr x) (cadr (trans ptr 1 0)))) pgr))
                  (and pgr (setq pgr (trans (last pgr) 0 1)))
                  (entdel l-tmp)))
          (progn (if pgl
                  (setq pxl pgl)
                  (setq pxl ptl))
                 (if pgr
                  (setq pxr pgr)
                  (setq pxr ptr))
                 (setq lst-ptn (vl-remove-if-not '(lambda (x) (< (car pxl) (car x) (car pxr))) (car lst-tn)))
                 (Polyline (append (if pgl
                                    (append lpt (list pgl))
                                    lpt)
                                   lst-ptn
                                   (if pgr
                                    (append (list pgr) lpr)
                                    lpr))
                           col
                           lay)
                 (entdel x)))))
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setvar 'CMDECHO cmd)
 (princ))

[Duong Nhat Duy 484]

Các bạn cho mình hỏi chút:

Mình muốn chuyển mã font trong dim (từ unicode sang tcvn3), hàm con thì mình có rồi, mà mình không thể lấy giá trị text có unicode trong dim bằng hàm vla-get-TextOverride.

Giả sử text là "Ví dụ" thì hàm vla-get-TextOverride chỉ trả về là "V? d?".

Có cách nào khắc phục ko nhỉ ?

[Doan Nguyen Van 494]

8 phút trước, Duong Nhat Duy đã nói:

Các bạn cho mình hỏi chút:

Mình muốn chuyển mã font trong dim (từ unicode sang tcvn3), hàm con thì mình có rồi, mà mình không thể lấy giá trị text có unicode trong dim bằng hàm vla-get-TextOverride.

Giả sử text là "Ví dụ" thì hàm vla-get-TextOverride chỉ trả về là "V? d?".

Có cách nào khắc phục ko nhỉ ?

Các hàm Vl- đều bị như thế, bác thay bằng (cdr (assoc 1 (entget (ent))) để lấy chữ có tiếng việt 

[Doan Van Ha 3212]

Chơi với unicode thì đừng chơi với vl/vla/vlax, vì mấy chú visualisp xử lý unicode rất có vấn đề.