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

Tue_NV

Moderator
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    4.260

  • Đã tham gia

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

  • Ngày trúng

    286

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

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

    Vào lúc 8/1/2024 tại 09:08, levietmy đã nói:

    Thường mình sd vào mục đích đại khái như đoạn code sau:

    (defun nhap( / st p)
      (INITGET 128)
      (SETQ P (GETPOINT "\nNhap"))
      (cond
        ((null p) (setq st nil))
        ((listp p) 

        ;Làm việc gì đó
        )
        ((= (type p) 'STR)
         (setq st p)
        )
      )
      st
    )
    ý mình muốn khi nhập text thì p có thể nhận khoảng trắng


    Bạn thử code này xem sao: 
    (defun nhap( / st p)
      (INITGET 128)
      (SETQ P (GETPOINT "\nNhap : ")) (princ)
         (if (= (type p) 'STR)
           (setq st (strcat p (getstring T p)))
           (setq st p)
        )
      st
    )

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

    23 giờ trước, luongtienlanh đã nói:

    Nhờ các anh sửa Lisp sau giúp em với ạ.

    Em tìm được lisp dưới đây để tùy chỉnh kích thước của dimension background mask so với kích thước mặc định của autocad.

    Tuy nhiên gặp vấn đề là Lisp này chỉ cho chọn 1 đối tượng trong 1 lệnh, nên khi chỉnh nhiều đối tượng sẽ mất rất nhiều thời gian. Nhờ các anh chỉnh giúp để sao nó có thể thực hiện cho nhiều đối tượng trong 1 lệnh với ạ.

    Link bài viết thảo luận về chủ đề Lisp này:

    https://forums.autodesk.com/t5/autocad-forum/dimension-fill-color-text-box-size/m-p/6984969/highlight/false#M872421

    Link tải Lisp của tác giả viết Lisp:

    https://cadtips.cadalyst.com/2d-editing/adjust-dimension-text-masking
    Em cám ơn các anh nhiều!

    DimFillResize.lsp

    DimFillResize.png

     

    Bạn gửi file chạy thử cho mình xem nhé!

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

    18 phút trước, pdhuyxn2 đã nói:

    Cám ơn bác Tuệ  và các Bác!

    Bác có thể bổ sung giúp Em trường hợp 2 là "Chon doi tuong gap khuc:" .Đối tượng đường gấp khúc là các line rời rạc

    Cám ơn Bác À !

    Di chuyen Block2.dwg

    Bạn dùng lệnh PEDIT nối Line với nhau rồi dùng Lisp trên là được thôi

     

    • Like 1

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

    Bạn

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

    Dạ file cad bị lệch 2m ạ. Em đã chỉnh lại rồi ạ. Cám ơn Bác!

    Di chuyen Block1.dwg

    Bạn thử code này: 

    (defun c:dch()
  (setq ssb (ssget '((0 . "INSERT"))) i 0)
   (setq dtgoc (car (entsel "\nChon doi tuong goc:")))
   (setq dtgkhuc (car (entsel "\nChon doi tuong gap khuc:")))
  (while (setq enameblock (ssname ssb i))
    (setq insp (vlax-curve-getClosestPointTo dtgoc (cdr(assoc 10 (entget enameblock)))))
    (setq dist (vlax-curve-getdistAtPoint dtgoc insp))
    (setq inp2 (vlax-curve-getpointAtdist dtgkhuc dist))
    (if (vlax-curve-getFirstDeriv dtgkhuc (vlax-curve-getparamatpoint dtgkhuc inp2))
        (setq angs (angle '(0 0 0) (vlax-curve-getFirstDeriv dtgkhuc (vlax-curve-getparamatpoint dtgkhuc inp2))))
    (setq angs (angle '(0 0 0) (vlax-curve-getFirstDeriv dtgkhuc (1+ (vlax-curve-getparamatpoint dtgkhuc inp2)))))
     )
    (setq vla-obj (vlax-ename->vla-object enameblock))
    (vla-move (setq vla-obj2 (vla-copy vla-obj)) (vlax-3d-point insp) (vlax-3d-point inp2))
    (vla-rotate vla-obj2 (vlax-3d-point inp2) angs)
    (setq i (1+ i))
    )
  )

    • Like 4
    • Vote tăng 1

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

    Vào lúc 15/7/2021 tại 11:47, keviet226 đã nói:

    Gửi các anh, chị diễn đàn cadviet.com

    Lần đầu tiên em đến với diễn đàn nên có gì không phải mong các anh, chị bỏ qua cho!
    Em nhờ anh chị hướng dẫn, hoặc viết giúp em lisp theo yêu cầu như sau:
    1. Sau khi quét chọn sẽ lọc ra đối tượng để tự tính tổng. VD loại A sẽ lọc theo loại A; B theo B và C theo C, nghĩa là thống kê mỗi loại có tổng bao nhiêu.
    2. Sau khi đối tượng nào đã được thống kê thì đổi màu để dễ kiểm soát. VD loại A đã tính tổng xong thì biến thành màu vàng chẳng hạn.
    Mong anh chị nào có thể hướng dẫn em viết, hoặc viết giúp em. Em sẽ trả phí đầy đủ ạ!
    Em xin cảm ơn nhiều!
     

    image.png

    Gửi file lên đi bạn!

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

    Chào Dương Nhat Duy!

    Bạn thử code sau:  

    
(defun c:test (/ a b c ptdau lst)
(setq a 
(list
 (list "A" (list 1 1) (list 2 2) (list 3 3))
 (list "B" (list 1 2) (list 3 4) (list 5 6))
 (list "C" (list 0 0) (list 0 0) (list 0 0))
 (list "A" (list 1 1) (list 1 1) (list 1 1))
 (list "B" (list 10 10) (list 10 10) (list 10 10))
))
(setq b (vl-sort a '(lambda(x y) (< (car x) (car y)))) lst '())
(while (/= (length b) 0)
  (setq c (vl-remove-if '(lambda(x) (/= (car x) (caar b))) b))
  (setq ptdau (car c))
  (if (cdr c)
    (foreach x (cdr c)
     (setq lst (append lst (list (list (car ptdau) (mapcar '(lambda(q z) (mapcar '+ q z)) (cdr ptdau) (cdr x))))))
    )
    (setq lst (append lst (list ptdau)))
  )
  (setq b (vl-remove-if '(lambda(x) (= (car x) (caar b))) b))
)
           lst)

    • Vote tăng 1

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

    @zutum:

    Lisp sửa lại đây bạn. Nếu đoạn thẳng và hình chữ nhật xiên cùng 1 góc thì Lisp chấp nhận luôn đó nhé 

    
(defun c:nb()
  (setq e1 (entsel "\nPick hinh chu nhat (pick vao canh) :"))
  (setq e2 (car (entsel "\nPick doan thang :")))
  (initget "+1 -1")
  (setq kieuchia (getkword "Kieu chia: [+1 -1] :"))
  (setq nan (getint "\n Nhap so nan :"))
  (setq p1 (vlax-curve-getStartPoint e2)) (setq p2 (vlax-curve-getEndPoint e2))
  (if (> (cadr p1)(cadr p2)) (setq pptg p2 p2 p1 p1 pptg))
  (setq d2 (distance p1 p2)) 
  (setq ptg (cadr e1)) (setq e (car e1))
  (setq p11 (vlax-curve-getPointAtParam e (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointto e ptg)))))
  (setq p12 (vlax-curve-getPointAtParam e (1+ (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointto e ptg))))))
  (setq d1 (distance p11 p12))   (if (< (cadr p11) (cadr p12)) (setq pb p11) (setq pb p12))
  (if (= kieuchia "+1") (setq khe (/ (- d2 (* nan d1)) (1- nan))) (setq khe (/ (- d2 (* nan d1)) (1+ nan))))
      (if (= kieuchia "-1") (setq p1 (polar p1 (angle p1 p2) khe)))
    (Repeat nan
      (command "._copy" e "" "_non" pb "_non" p1)
     (setq p1 (polar p1 (angle p1 p2) (+ d1 khe)))
    )
)

    • Like 2

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

    @zutum: Lisp chạy ra đúng y hình 2 mà. Bạn test lại thử 
    dữ liệu là 1 đoạn thẳng và 1 hình chữ nhật. Bạn chú ý khi pick trên hình chữ nhật là pick trên cạnh của hình chữ nhật (cần chia trên đoạn thẳng đó)

    @cuongtk2 : đâu có. Lisp nhận các RECTANG cho dù là vẽ trên xuống hay vẽ dưới lên

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

    Bạn có thể nghiên cứu thêm hàm vl-sort.

    Thông thường mình có tùy chọn sắp xếp hoặc ko sắp xếp bản vẽ. Với th ko sắp xếp bản vẽ thì mình hay sử dụng select object fence (chọn bản vẽ theo đoạn thẳng) bản vẽ nào cắt qua đoạn thẳng đó trước thì đánh trước. Rất nhanh

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

    Bạn dùng thử lisp NB

    Command: NB

    Pick hinh chu nhat (pick vao canh) : -> Pick vào cạnh chữ nhật (chính là cạnh nan cần chia)
    Pick doan thang :

    Kieu chia: [+1 -1] :+1

     Nhap so nan :10 

    
(defun c:nb()
  (setq e1 (entsel "\nPick hinh chu nhat (pick vao canh) :"))
  (setq e2 (car (entsel "\nPick doan thang :")))
  (initget "+1 -1")
  (setq kieuchia (getkword "Kieu chia: [+1 -1] :"))
  (setq nan (getint "\n Nhap so nan :"))
  (setq p1 (vlax-curve-getStartPoint e2)) (setq p2 (vlax-curve-getEndPoint e2))
  (setq d2 (distance p1 p2)) 
  (setq ptg (cadr e1)) (setq e (car e1))
  (setq p11 (vlax-curve-getPointAtParam e (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointto e ptg)))))
  (setq p12 (vlax-curve-getPointAtParam e (1+ (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointto e ptg))))))
  (setq d1 (distance p11 p12))   (if (< (cadr p11) (cadr p12)) (setq pb p11) (setq pb p12))
  (if (= kieuchia "+1") (setq khe (/ (- d2 (* nan d1)) (1- nan))) (setq khe (/ (- d2 (* nan d1)) (1+ nan))))
      (if (= kieuchia "-1") (setq p1 (polar p1 (angle p1 p2) khe)))
    (Repeat nan
      (command "._copy" e "" "_non" pb "_non" p1)
     (setq p1 (polar p1 (angle p1 p2) (+ d1 khe)))
    )
)

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

    48 phút trước, zutum đã nói:

     

    @Tue_NV:  thanks Tuệ. Hình như bạn chưa hiểu ý mình. Ý mình muốn bạn giúp 1 lisp có thể tự động tính luôn khoảng cách. Nói đơn giản mình có 1 hình chữ nhất bất kì và 1 đoạn thẳng. Mình muốn khi bấm lisp chọn hình chữ nhật, chọn đoạn thẳng ( pick điểm đầu diểm cuối đoạn thẳng cũng được ) . Nhập số nan lisp tự động chia cách khe và nan trên đường thẳng đó.

     

    Như vậy là khi nhập số nan lấy chiều dài đoạn thẳng đó đi tính toán. Vậy thì khi chia tách là bề rộng nan thay đổi hay giữ nguyên, bề rộng khe thay đổi hay giữ nguyên??? 

    1 đoạn thẳng chia làm bề rộng nan và bề rộng khe và lại phụ thuộc vào số nan nữa? Thietj khó hiểu quá

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

    Cái nào cũng phải có khoảng cách mới array. Chứ không có khoảng cách thì array thế nào được

    Quick code cho bạn (khoảng cách nhập = khoảng cachs nan + khe 

    
(defun c:nb()
  (setq ss (ssget))
  (setq kc (getreal "\khoang cach nan + khe : "))
  (setq nan (getint "\n Nhap so nan :"))
  (command "._Array" ss "" "R" "C" nan "1" "S" kc "")
)

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

    Cái này na ná như lệnh ARRAY. Bạn có thể nói rõ hơn không?  ý dưới đây của bạn không???

    "Bấm tên lệnh chọn đối tượng ( là nan bàn ) sau đó chọn đoạn thẳng. Sau đó chọn (1) hoặc (-1) [ chọn 1 khi số khe bằng số nan+1 chọn -1 khi số khe bằng số nan -1 ] .

    Tiếp nhập số nan thì lisp tự chia số nan và khe.trên đoạn thằng mà mình đã chọn ( hình 2 )."

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

    Đường đỏ dưới hình cần cắt. Thì làm sao hiểu ý của USER là cắt trong vùng 1, hay 2, hay 3, hay 4?? Nên nhớ rằng đường cắt của bạn chạy không có quy luật nào cả? Thì làm sao nhận biết được?? => Nếu bạn không đưa ra được "Luật chơi" thì bài toán sẽ không có lời giải . Việc chọn nhiều đường PLINE cùng lần để công vciệc nhanh hơn sẽ bất khả thi -> phá sản

    image.png

×