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

tannguyen291

Thành viên
  • Số lượng nội dung

    449
  • Đã tham gia

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

  • Ngày trúng

    43

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


  1. mã này có thể chạy được với các hình dạng giống bản vẽ. chữa rõ với các hình dạng khác hoạt động được đến đâu :((

    (defun c:test (/ sel ss lst eng pt ntx ang lstss )
      (setq 
        sel (ssget '((0 . "LINE")))
        ss (acet-ss-to-list sel)
        pt (getpoint "\nStart Point:")
        lst (mapcar 
              '(lambda (x / a b) 
                 (setq
                   a (cdr (assoc 10 (entget x))) 
                   b (cdr (assoc 11 (entget x)))
                 )
                 (if (< (distance a pt) (distance b pt)) a b)
               )
              ss
            )
        ntx (car (vl-sort-i lst '(lambda (a b) (< (distance a pt) (distance b pt)))))
        ptx (if (eq (nth ntx lst) (cdr (assoc 10 (entget (nth ntx ss)))))
              (cdr (assoc 11 (entget (nth ntx ss))))
              (cdr (assoc 10 (entget (nth ntx ss))))
            )
        ss (list (nth ntx ss))
        lst (list (nth ntx lst))
        ang (angle (car lst) ptx)
      )
      (acet-ss-zoom-extents sel)
      (while (and
               (setq lstss (ssget "F" (list (car lst) ptx )'((0 . "LINE"))))
               (setq lstss (acet-ss-to-list lstss))
               (setq lstss (vl-remove-if '(lambda (x) (member x ss)) lstss))
             )
        (setq 
          eng (list (cdr (assoc 10 (entget (car lstss)))) (cdr (assoc 11 (entget (car lstss)))))
          ntx (inters ptx (car lst) (car eng) (cadr eng) nil)
          ss (cons (car lstss) ss)
          lst (cons ntx lst)
        )
        (if (minusp (cos (- (angle ntx (car eng)) ang)))
          (setq ptx (cadr eng))
          (setq ptx (car eng))
        )
        (setq ang (angle (car lst) ptx))
      )
      (setq lst (reverse (cons ptx lst)))
      (entmakex
          (append
              (list
                 '(000 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                 '(070 . 1)
              )
              (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
          )
      )
      (princ)
    )

     

    • Like 1

  2. tải lisp convexhull về rồi thêm đoạn mã này nữa mới chạy được 

    (defun c:test (/ ss lst )
      (setq 
        ss (acet-ss-to-list (ssget '((0 . "LINE"))))
        lst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x)))) ) ss)
        lst (LM:ConvexHull (apply 'append lst))
      )
      (entmakex
          (append
              (list
                 '(000 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                  (cons 90 (length lst))
                 '(070 . 1)
              )
              (mapcar '(lambda ( x ) (list 10 (car x)(cadr x) )) lst)
          )
      )
    )

     


  3. 48 phút trước, limfx đã nói:

    Cẩm ơn a tannguyen291 và amateurday: Thêm kiểm tra góc giữa 2 đường nữa là OK. Thanks!

    Kiểm tra nhiều thế làm gì chỉ đơn giản là tính tan(alpha) bằng nhau là xong mà. 

    ngay từ đầu mình thấy bài đơn giản nên không định trả lời. không ngờ gây khó mọi người đến vậy.

    image.png.d3ad49ad37da871e967d0203de2367ac.png

    từ p1 p2 thì có rất nhiều cách để tìm ra px1 và px2.


  4. 22 phút trước, NTHAHT đã nói:

    Theo mình biết, một số khách hàng họ có nhu cầu file cuối cùng ở dạng vector để đưa lên web (... có thể convert từ file *.dwg ), yêu cầu màu sắc cụ thể.

    nếu theo nhu cầu đó thì viết 1 lisp convert index ra true. nhanh hơn đỡ phải chọn đi chọn lại nhiều lần. màu sắc tương tự, bác thấy sao. :)


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

    Sao bạn biết không đúng?

    Em cũng không hiểu true color để làm gì vì mình quản lý nét in bằng index color. 

    việc màu gần nhau có thể hơi khác một chút nhưng với công nghệ máy in thông thường khi in ra cũng không nhận biết được.

    không biết các ngành khác thế nào chứ ngành quy hoạch em đang làm thì có thông tư 04/2022 đã định rõ màu cho từng loại layer được sử dụng. nên cũng không nhất thiết phải true color làm gì.


  6. Mình đang nghiên cứu ra rồi nhé. sử dụng hàm (getpropertyvalue [ename] [property]) 

    property là string có dạng "AcDbDynBlockProperty" + "distance..."

    nếu có giá trị là hiện nếu error là ẩn. 

    đi kèm với cặp lệnh vl-catch-all-error-p vl-catch-all-apply thì ok luôn.

    (defun c:test (/ ent lst lstcheck lstparavisible )
      (setq 
        ent (car (entsel))
        lst (LM:getdynprops (vlax-ename->vla-object ent))
        lst (vl-remove-if-not '(lambda (x) (eq 'REAL (type (cdr x)))) lst)
        lst (mapcar '(lambda (x) (strcat "AcDbDynBlockProperty" (car x)) ) lst)
        lstcheck (mapcar '(lambda (x) (vl-catch-all-apply 'getpropertyvalue (list ent x))) lst)
        lstparavisible (mapcar 
                         '(lambda (a b) 
                            (if (not (vl-catch-all-error-p b))
                              (cons (substr a 21) b)
                            )
                          )
                        lst lstcheck
                       )
      )
      (vl-remove nil lstparavisible)
    )
    
    (defun LM:getdynprops (blk)
      (mapcar '(lambda (x)
    	     (cons (vla-get-propertyname x) (vlax-get x 'value))
    	     )
    	  (vlax-invoke blk 'getdynamicblockproperties)
    	  )
      )
    • Like 1
    • Vote tăng 1

  7. 2 phút trước, huunhantvxdts đã nói:

    mình đã biết visible ở trạng thái nào rồi thì đặt điều kiện để lấy distance tương ứng.

     image.thumb.png.a4cde0484c46f9c6623e3028fd8537f6.png

    biết trước thì nói làm gì bác. Bạn duy hỏi là trường hợp tổng quát hơn. có nhiều block với các parameter khác nhau.

    em đề xuất cái explode cũng là dởm đời không dùng được.


  8. 6 phút trước, limfx đã nói:

    Cũng không cần explode ra đâu anh. (car (nentsel)) cũng đã lấy được đối tượng visible rồi !

    Mình không biết bạn DUY đang làm gì nhưng phải dùng đến lisp kiểu này cho thấy phải thực hiện trên rất nhiều đối tượng chứ không phải 1. bạn không thể nentsel liên tục được. 

    việc explode cũng chỉ làm với 1 block mẫu để lấy danh sách thông tin. sau đó cứ thế chạy lisp lấy độ dài.

    • Vote tăng 1

  9. Vào lúc 17/5/2024 tại 17:34, Duong Nhat Duy đã nói:

    Mọi người cho mình hỏi về Block động.

    Mình có hàm thống kê Parameters của Leemac:

    
    (defun LM:getdynprops (blk)
      (mapcar '(lambda (x)
    	     (cons (vla-get-propertyname x) (vlax-get x 'value))
    	     )
    	  (vlax-invoke blk 'getdynamicblockproperties)
    	  )
      )
    ;(LM:getdynprops (vlax-ename->vla-object (car (entsel))))

    Nhưng khi áp dụng cho Block có nhiều trạng thái, ví dụ: Drawing1.dwgDistance1 nằm trong State1, Distance2 nằm trong State2, thì hàm trên vẫn thống kê cả 2 cái Distance.

    Vậy cho mình hỏi có cách nào nhận biết Parameter nào đang hiển thị trong trạng thái nào không nhỉ ?

     Cảm ơn các bạn !

    Hơi khó để biết parameter nào thuộc visible nào. nhưng có 1 cách đơn giản và hơi nông dân là explode ra. 

    bạn sẽ thấy chỉ có đối tượng visible được tạo mới. đối tượng invisible không có.

    như vậy là xác định được rồi. :)

    liên tục explode sẽ làm lisp chạy chậm. 

    giải quyết bằng việc lưu lại thông tin vào ldata để lần tiếp theo chạy lisp không cần explode nữa.

    • Like 1

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

    Ku AI này kinh điển thiệt, nó phân tích rõ ràng, nếu nó ra đời sớm hơn đỡ phải nhọc óc mò lisp

    nghe nói cad 2025 bản trả phí có AI tích hợp, chắc chưa ngon đâu nhưng vài bản nữa thì không biết được. thời của mấy ông viết code dạo chắc sắp hết. :))

    • Vote tăng 1

  11. 19 giờ trước, vietduc147258 đã nói:

    Thử cái này nhé. Suy nghĩ đơn giản thôi nên viết đơn giản vậy thôi. 

    Nhược điểm là chiều dài, chiều rộng của HCN phụ thuộc vào điểm thứ 3 thôi. 

    (defun c:cnn (/ pt1 pt2)
        (setq    pt1    (getpoint "\nChon diem dau:"))
        (setq    pt2    (getpoint pt1 "\nChon goc nghieng:"))
    (command "_.rectang" pt1 "R" pt2 Pause)
    (command "_.rectang" "0,0" "R" 0 \)
    )

    đã nói là giống sketchup rồi mà. dùng thử cái lisp lee mac mình đăng bên trên xem có dễ dùng hơn k.


  12. 4 phút trước, limfx đã nói:

    Không hiểu cái em này đang nghĩ gì, hỏi xin lisp mình gửi rồi lại show lên hỏi thiên hạ, bó tay!

    Lisp của bạn cũng đâu có gì ghê gớm đâu, bạn cũng từng share cái này rồi thì phải. 

    Với một người mới học lisp bạn gửi cho 1 cái thuộc phạm trù object arx để làm khó người ta chứ chia sẻ kiến thức cái chi.

    @MaiLinh2006 bạn quăng cái sách vào mặt tôi. :((


  13. 13 phút trước, cuongtk2 đã nói:

    Cảm nghĩ  riêng (bhatch) là 1 hàm không tham số, trả về nil. Mục tiêu cho người ta thi hành lệnh Hatch.

    (defun c:test()
      (bhatch)
      (setq pt (getpoint "\ntest pick:"))
      (princ pt))
            

    hàm (bhatch) nó không thuộc hệ thông command. người dùng thực hiện hết lệnh mới chuyển đến dòng tiếp theo (getpoint) ạ. 


  14. 1 phút trước, cuongtk2 đã nói:

    @tannguyen291Máy không chạy có thể là do :

     1. Thiếu hàm.

    2. Biến toàn cục đổi sang biến cục bộ, nên máy chú nó OK vì biến đó đang trong bộ nhớ. Nhưng sang máy người khác thì nó chưa có giá trị đó. Chú chỉ cần đóng Cad mở lại mà vẫn chạy được là đúng,

    2. thì không thể nào.

    1. thì ... cái này do cad chứ lisp của em thuần tuý lisp. còn chưa dùng đến vla , vlax, expresstool, hàm phụ trợ.

    Lisp này máy mac còn chạy chứ nói gì Cad LT

     


  15. 35 phút trước, duy782006 đã nói:

    BHATCH lâu nay mình bỏ ko dùng nên tìm chưa ra. Nhưng muốn chọn điểm rồi thực hiện lệnh hatch thì mình tạm dừng lisp trả lại cho cad ảnh làm xong mình cho lisp chạy tiếp.

    (initdia)
    (command "hatch")
    (while (< 0 (getvar "CMDACTIVE"))
    (command pause)

     

     

     

    À tìm ra rồi đây.

    (command "bhatch" "p" "" tiledehatch gocdehatch diemchona "") 

    bác chưa theo dõi phía trên rồi :)

    em đang muốn hỏi về function bhatch không phải command bhatch ạ.

×