Chuyển đến nội dung
Diễn đàn CADViet

thanhduan2407

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.161

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    26

Bài đăng được đăng bởi thanhduan2407

  1. Đã đăng · Trả lời báo cáo

    [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
)

     

  3. Đã đăng · Trả lời báo cáo

    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

    Thành Duân.png

    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 ạ.

  7. Đã đăng · Trả lời báo cáo

    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.

  8. Đã đăng · Trả lời báo cáo

    Với ý tưởng tạo đường bao tối ưu chứa tập hợp các điểm Point và khoảng cách giữa các đoạn không vượt quá con số a nào đó nhằm tìm kiếm đường bao tối ưu bám sát các điểm nhất. Em đã cố gắng nghiên cứu rất lâu rồi nhưng chưa tìm ra cách. Mong các Pro chỉ giáo, viết hoặc gợi ý cho em với ạ! Em có sưu tầm được lisp của Lee-Mac về đường bao lồi Convex Hull nhưng chưa chỉnh sửa được theo đúng ý mình. Em xin gửi code tham khảo lên đây và hình ảnh.

    Cảm ơn các bác đã quan tâm. 

    (defun C:00 (/ LST LTSPOINT SSPOINT X )
  (setq ssPoint (ssget '((0 . "POINT"))))
  (if ssPoint
    (progn
      (setq LtsPoint (LM:ss->ent ssPoint))
      (setq lst (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) LtsPoint))
      (setq lst (LM:ConvexHull lst))
      (entmakex
	(append
	  (list
	    '(000 . "LWPOLYLINE")
	    '(100 . "AcDbEntity")
	    '(100 . "AcDbPolyline")
	    (cons 90 (length lst))
	    '(070 . 1)
	  )
	  (mapcar '(lambda (x) (cons 10 x)) lst)
	)
      )
    )
  )
  (princ)
)




;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to return the Convex Hull of
;; a
;; list of
;; points.

(defun LM:ConvexHull (lst  / ch p0)
  (cond
    ((< (length lst) 4) lst)
    ((setq p0 (car lst))
     (foreach p1 (cdr lst)
       (if (or (< (cadr p1) (cadr p0))
	       (and (equal (cadr p1) (cadr p0) 1e-8)
		    (< (car p1) (car p0))
	       )
	   )
	 (setq p0 p1)
       )
     )
     (setq lst
	    (vl-sort
	      lst
	      (function
		(lambda	(a b / c d)
		  (if
		    (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
		     (< (distance p0 a) (distance p0 b))
		     (< c d)
		  )
		)
	      )
	    )
     )
     (setq ch (list (caddr lst) (cadr lst) (car lst)))
     (foreach pt (cdddr lst)
       (setq ch (cons pt ch))
       (while
	 (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
	  (setq ch (cons pt (cddr ch)))
       )
     )
     ch
    )
  )
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear

(defun LM:Clockwise-p (p1 p2 p3)
  (< (-	(* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
	(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
     )
     1e-8
  )
)




(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)

     

    https://s844.photobucket.com/user/thanhduan2407/media/sssss_zpsxbqp2zsn.png.html

     

  11. Đã đăng · Trả lời báo cáo

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

    Chẳng hạn hàm này đọc cách user đã đặt về dấu ngăn cách, và hàm ghi chắc cũng tương tự:
    (vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")

    Cháu ghi vào thẻ theo đường dẫn ở dưới. Trong thẻ này cháu ghi các thông tin vào đó bác ạ!

    Nhưng nếu ko tích dấu chọn Allow thì không tạo được.

    HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows 

    
(defun sv:key-r	(Sub typ)
  (setq Main "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows NT\\CurrentVersion\\Windows")
  (setq sVal (vl-registry-read Main Sub))
  (cond
    ((= typ "i") (setq nVal (atoi sVal)))
    ((= typ "r") (setq nVal (atof sVal)))
    ((= typ "s") (setq nVal sVal))
  )
)

(defun sv:key-w	(Sub Val typ)
  (setq Main "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows NT\\CurrentVersion\\Windows")
  (cond
    ((= typ "i") (vl-registry-write Main Sub (rtos Val 2 0)))
    ((= typ "r") (vl-registry-write Main Sub (rtos Val 2 2)))
    ((= typ "s") (vl-registry-write Main Sub Val))
  )
)

     

  16. Đã đăng · Trả lời báo cáo

    Vào lúc 22/8/2018 tại 14:38, monavamonava đã nói:

    File bác gửi đúng với yêu cầu đề ra của em. Không biết CODE đó là như thế nào, bác có thể hướng dẫn chia sẻ cách làm cho em cũng như mọi người biết, học tập và áp dụng với được không. Hóng sự trợ giúp và phản hồi của bác. 

    Code nó dài lắm và nhiều thao tác.

    - Bước 1: Xuất tọa độ giao điểm của mắt lưới ra XY

    - Bước 2: Tạo mô hình TIN từ các Text số liệu mặt cắt

    - Bước 3: Nội suy cao độ từ file XY đó dựa trên mô hình TIN.

     

  18. Đã đăng · Trả lời báo cáo

    1 giờ trước, quocmanh04tt đã nói:

    Mình tham gia đề xuất 1 PA (dùng command):

     Xét từng ô lưới:

    * Trong từng ô lưới (có 4 đỉnh) kiểm tra những đỉnh nào nằm trong Pline kín (trong mỗi đỉnh này có đặc điểm riêng ll, ul, ur và lr)

    * Sẽ có 4 trường hợp: 1, 2, 3 hoặc 4 đỉnh nằm trong pline kín

    - Nếu 1 đỉnh: xét xem là ll hay tl... polar điểm này về phía 3 điểm còn lại 1 khoảng nhỏ, dùng lệnh BOUNDARY để tạo BOUNDARY

    - Nếu 4 đỉnh thì chỉ cần lấy tâm của ô lưới -> BOUNDARY

    - 2 hay 3 thì xét các BOUNDARY được tạo ra có trùng toạ độ hay không (điểm pick tương tự trường hợp 1)...

    - Trường hợp không có đỉnh nào, mà lưới và pline kín giao nhau thì lấy tất cả điểm giao và những điểm của pline nằm trong ô lưới => sort các điểm theo pline kín và tạo Boundary.

     

     

    Em ngóng. Em đã xào nấu mấy cái trước và đạt được ý muốn rồi.

    Chờ phương án 1 của bác . Hii

     

  19. Đã đăng · Trả lời báo cáo

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

    1). Cách dùng hàm GetNewEnts để lấy lst các đối tượng được tạo ra sau 1 loạt lệnh nào đó:

    - (setq ent (entlast))

    - Làm 1 loạt lệnh...

    - (setq lst (GetNewEnts ent))

    2). Đúng là cả 2 lisp đều cho ra 1 region dính chùm. Không cần dùng lisp, chỉ dùng command region 2 đối tượng liên quan cũng có kết quả tương tự. Có lẽ do bản chất lệnh region nó thế

    Dạ vâng bác! Nhưng kết quả vẫn trả về nil bác ạ!

    Cháu cũng sử dụng hàm tương tự của bác nhưng kq nó về nil. Bực mình lắm bác ạ

  20. Đã đăng · Trả lời báo cáo

    3 giờ trước, ndtnv đã nói:
    • testregion.lsp
      lisp help
    •   
    

(defun C:TestRegion (/ s r o i t0)
    (setq s (vlax-ename->vla-object(car (entsel))))
    (setq r (mapcar 'vlax-ename->vla-object
                                    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "REGION")(8 . "LUOI"))))))))
    (setq t0 (getvar "MilliSecs"))
    (foreach e r
        (setq o (vla-copy s))
        (setq i (vla-boolean e acIntersection o))
    )
    (-(getvar "MilliSecs") t0)
)

    Test với bản vẽ có ô lưới = 1/10 của bv bạn đưa lên, có 540 region mất khoảng 1.5s

    Nếu dùng select các ô có giao với region gốc time còn giảm

    Trường hợp region có nhiều vùng, dùng lisp region=>pline, rồi region lại có lẽ lâu hơn 1 chút

    BOUNDARY.dwg

    Em chào anh ndtnv !

    Em nhận ra, khi vùng 1 giao với vùng 2 tạo ra n vùng nhưng chỉ có 1 region duy nhất. Khi Explode Region đó ra thì nó sẽ tạo thành 2 region.

    Đây là bản vẽ Test.

    P/s: Bác DVH: Cháu có dùng hàm của bác nhưng chắc cháu chưa biết cách lấy nên danh sách vẫn trả về nil bác ạ!

    Cháu thử cả của bác và của anh ndtnv cùng 1 kết quả là Region chồng Region.

     

    Link: http://www.mediafire.com/file/4gkok3u3ue5iywa/BAN_VE_TEST.dwg/file

     

  21. Đã đăng · Trả lời báo cáo

    1 giờ trước, ndtnv đã nói: 
    
(defun C:TestRegion (/ s r o i t0)
    (setq s (vlax-ename->vla-object(car (entsel))))
    (setq r (mapcar 'vlax-ename->vla-object
                                    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "REGION")(8 . "LUOI"))))))))
    (setq t0 (getvar "MilliSecs"))
    (foreach e r
        (setq o (vla-copy s))
        (setq i (vla-boolean e acIntersection o))
    )
    (-(getvar "MilliSecs") t0)
)

    Test với bản vẽ có ô lưới = 1/10 của bv bạn đưa lên, có 540 region mất khoảng 1.5s

    Nếu dùng select các ô có giao với region gốc time còn giảm

    Trường hợp region có nhiều vùng, dùng lisp region=>pline, rồi region lại có lẽ lâu hơn 1 chút

    BOUNDARY.dwg

    Bác cho em hỏi 1 chút! Làm thế nào lấy được danh sách các region ấy sau khi tìm acIntersection?

    Em muốn tóm được nó và biển nó thành Polyline..

  22. Đã đăng · Trả lời báo cáo

    4 phút trước, ndtnv đã nói:

      

    
(defun C:TestRegion (/ s r o i t0)
    (setq s (vlax-ename->vla-object(car (entsel))))
    (setq r (mapcar 'vlax-ename->vla-object
                                    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "REGION")(8 . "LUOI"))))))))
    (setq t0 (getvar "MilliSecs"))
    (foreach e r
        (setq o (vla-copy s))
        (setq i (vla-boolean e acIntersection o))
    )
    (-(getvar "MilliSecs") t0)
)


     

    Test với bản vẽ có ô lưới = 1/10, 540 region mất khoảng 1.5s

    Nếu dùng select các ô có giao với region gốc time còn giảm

    Trường hợp region có nhiều vùng, dùng lisp region=>pline, rồi region lại có lẽ lâu hơn 1 chút

    BOUNDARY.dwg

    Em đã lỡ bấm quá nhiều Like rồi nên giờ không biết bấm Like bác kiểu gì nữa. Cảm ơn bác rất nhiều. Hii

  23. Đã đăng · Trả lời báo cáo

    12 phút trước, tien2005 đã nói:

    Bạn tham khảo lips hatch vùng kính của các đối tượng giao nhau ở đây xem có giup được gì không, mình thấy nó cũng tượng tự với y/c của Bạn

     

    http://www.cadviet.com/forum/topic/93584-nho-viet-lisp-hatch-vung-kin-cua-cac-doi-tuong-giao-nhau/page-2

    Cảm ơn bác @tien2005 ! Em sẽ nghiên cứu thêm gợi ý của bác

  24. Đã đăng · Trả lời báo cáo

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

    Viết giúp chú theo PA2 của anh Gia_bach (PA1 anh Gia_bach xét thiếu các đỉnh).

    Không biết số ent màu hồng có nhiều không, chứ dùng PA command hơi ì ạch nếu số lượng đủ lớn.

      

    

(defun C:HA(/ old ent lst ds1 ds2)
 (command "undo" "be")
 (setq old (entlast))
 (setq ent (car (entsel "\nChon Pline mau trang: ")))
 (princ "\nChon tat ca o vuong mau hong: ")
 (setq lst (#SS->List  (ssget)))
 (mapcar '(lambda(e) (command "copy" e "" "none" '(0 0) "none" '(0 0)) (command "region" (entlast) "")) lst)
 (setq ds1 (GetNewEnts old) old (entlast)) 
 (repeat (length lst) (command "copy" ent "" "none" '(0 0) "none" '(0 0)) (command "region" (entlast) ""))
 (setq ds2 (GetNewEnts old) i -1)
 (repeat (length ds1)
  (command "INTERSECT" (nth (setq i (1+ i)) ds1) (nth i ds2) ""))
 (command "undo" "e") (princ))
(defun GetNewEnts (ename / new) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new)))) new)        ; list ename
(defun #SS->List (ss / i lst) (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst))))

     

     

    Bác Doan Van Ha viết OK rồi ạ!  :D

     

×