Sửa Auto lisp break trong cad

[Victory8x 0]

Em chào các bác,

Qua youtube, e có xem được 1 bác tạo và share lisp về lệnh break trong cad rất hay và hữu ích. (link đây ạ : https://www.youtube.com/watch?v=9R7GlOnxTZg )

Để vận dụng cho việc tạo join trong lập trình cnc cho laser, e muốn khoảng break = 1mm thì cần sửa lại code như nào ạ?

Bác nào rành có thể giúp đỡ e được ko?

E gửi đính kèm file code và hình ảnh mong muốn.

Em cảm ơn ạ!!!

Break First - BRF.lsp

[Victory8x 0]

đoạn mã code đây ạ:

 

(defun c:BRF (/ *Error* osold ob ob1 pt pt1)
(defun *error* (msg)
  (setvar "osmode" osold)
  (princ msg)
  (princ))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq osold (getvar "osmode"))
(setvar "osmode" 32)

(while
    (and
        (setq ob1 (car (entsel "Chon doi tuong Break : ")))
        (not (redraw ob1 3))
        (setq pt1 (getpoint "\nChon diem Break : "))
    ); End And

  
      (setq pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object ob1) pt1)
          ob (ssadd ob1))
      (command "break" ob pt pt)
);endwhile
  (setvar "osmode" osold)
  (princ ))

[7o7 61]

Lisp này của bác @Danh Cong , bạn nhắn tin cho bác ấy sửa dùm.

[Victory8x 0]

Em chỉ muốn khoảng bẻ gãy thành 2 đối tượng = 1mm ạ

[Victory8x 0]

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

Lisp này của bác @Danh Cong , bạn nhắn tin cho bác ấy sửa dùm.

e có hỏi rồi nhưng bác ý bảo e lên đây hỏi. bác ý giờ ko viết code nữa

[7o7 61]

50 phút trước, Victory8x đã nói:

e có hỏi rồi nhưng bác ý bảo e lên đây hỏi. bác ý giờ ko viết code nữa

Bác í rửa tay gác kiếm rồi à? chắc viết code chán quá chẳng được gì.

Thấy cái lisp này cũng dễ nên giúp bạn làm phước vậy.

Lisp hỏi thêm điểm thứ 2 để biết hướng break.

BRF.lsp

[Victory8x 0]

17 phút trước, 7o7 đã nói:

Bác í rửa tay gác kiếm rồi à? chắc viết code chán quá chẳng được gì.

Thấy cái lisp này cũng dễ nên giúp bạn làm phước vậy.

Lisp hỏi thêm điểm thứ 2 để biết hướng break.

BRF.lsp

Quá đẳng cấp.

Cảm ơn bác nhiều ạ!!!

 

 

[Victory8x 0]

Vào lúc 10/12/2022 tại 13:55, 7o7 đã nói:

Bác í rửa tay gác kiếm rồi à? chắc viết code chán quá chẳng được gì.

Thấy cái lisp này cũng dễ nên giúp bạn làm phước vậy.

Lisp hỏi thêm điểm thứ 2 để biết hướng break.

BRF.lsp

Bác ơi, e có dùng 1 thời gian thì e thấy nó phải click 3 lần ( lần 1 - chọn đường; lần 2 - chọn vị trí; lần 3 - chọn hướng), có cách nào sửa dc code để chỉ phải click 1 lần dc luôn ko bác? vì e phải thực hiện nhiều lần trên 1 bản vẽ có nhiều chi tiết, nên e muốn tiết kiêm thời gian. Bác giúp e với ạ...

[7o7 61]

Click 1 lần cũng được nếu quy định điểm 2 ở bên phải hoặc bên trên điểm 1, nhưng cho hỏi đường của bạn là LINE hay POLYLINE?

[Victory8x 0]

5 phút trước, 7o7 đã nói:

Click 1 lần cũng được nếu quy định điểm 2 ở bên phải hoặc bên trên điểm 1, nhưng cho hỏi đường của bạn là LINE hay POLYLINE?

dạ, quy định ở bên trái hoặc phải của vị trí đưa chuột đến click đều ok ạ, e ko quan trọng chính xác vị trí. Mục đích e chỉ cần 1 điểm break tại khu vực của đường đó >> để e giữ tôn cho khỏi cong vênh lên sau khi cắt ạ. Bác check bản vẽ giúp e xem cho rõ hơn mục đích của e vơi.

5s.dwg

[NTHAHT 53]

Bạn thử lisp này xem sao.

(defun c:brf  (/ ang ent poi sel)
  (while (and (setq sel (entsel "\nChon vi tri Break: "))
              (wcmatch (cdr (assoc 0 (entget (setq ent (car sel))))) "*LINE"))
    (setq poi (vlax-curve-getClosestPointTo ent (cadr sel))
          ang (angle '(0 0 0)
                     (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent poi))))
    (command "break" ent "_none" (polar poi ang 0.5) "_none" (polar poi ang -0.5)))
  (princ))

[Victory8x 0]

21 phút trước, NTHAHT đã nói:

Bạn thử lisp này xem sao.

(defun c:brf  (/ ang ent poi sel)
  (while (and (setq sel (entsel "\nChon vi tri Break: "))
              (wcmatch (cdr (assoc 0 (entget (setq ent (car sel))))) "*LINE"))
    (setq poi (vlax-curve-getClosestPointTo ent (cadr sel))
          ang (angle '(0 0 0)
                     (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent poi))))
    (command "break" ent "_none" (polar poi ang 0.5) "_none" (polar poi ang -0.5)))
  (princ))

Quá ok bác ơi, đúng cái e cần. Bác cho e hỏi chỉnh khe hở đang là 1mm thành 0.5mm thì sửa cái nào bác?

[NTHAHT 53]

Bạn sửa ở chỗ 0.5 thành 0.25, -0.5 thành -0.25

[NTHAHT 53]

Gửi bạn bản này đầy đủ hơn. Hiệu chỉnh khe hở thì ở chỗ số 1 màu đỏ.

(defun c:BR2  (/ *error* cmd ent khe poi sel)
  (defun *error* (msg) (setvar 'CMDECHO cmd) (princ msg) (princ))
  (setq cmd (getvar 'CMDECHO)
        khe 1)
  (setvar 'CMDECHO 0)
  (while (and (setq sel (entsel "\nChon vi tri Break: "))
              (wcmatch (cdr (assoc 0 (entget (setq ent (car sel))))) "*LINE")
              (setq poi (vlax-curve-getClosestPointTo ent (cadr sel))))
    (apply 'vl-cmdf
           (apply 'append
                  (cons (list "break" ent)
                        (mapcar '(lambda (x)
                                   (list "_none"
                                         (vlax-curve-getPointAtDist ent
                                                                    (+ (vlax-curve-getDistAtPoint ent poi) (* x 0.5 khe)))))
                                '(-1 1))))))
  (setvar 'CMDECHO cmd)
  (princ))

[Victory8x 0]

19 phút trước, NTHAHT đã nói:

Gửi bạn bản này đầy đủ hơn. Hiệu chỉnh khe hở thì ở chỗ số 1 màu đỏ.

(defun c:BR2  (/ *error* cmd ent khe poi sel)
  (defun *error* (msg) (setvar 'CMDECHO cmd) (princ msg) (princ))
  (setq cmd (getvar 'CMDECHO)
        khe 1)
  (setvar 'CMDECHO 0)
  (while (and (setq sel (entsel "\nChon vi tri Break: "))
              (wcmatch (cdr (assoc 0 (entget (setq ent (car sel))))) "*LINE")
              (setq poi (vlax-curve-getClosestPointTo ent (cadr sel))))
    (apply 'vl-cmdf
           (apply 'append
                  (cons (list "break" ent)
                        (mapcar '(lambda (x)
                                   (list "_none"
                                         (vlax-curve-getPointAtDist ent
                                                                    (+ (vlax-curve-getDistAtPoint ent poi) (* x 0.5 khe)))))
                                '(-1 1))))))
  (setvar 'CMDECHO cmd)
  (princ))

Cảm ơn bác rất nhiều!!! quá ok rồi ạ. 

[Victory8x 0]

Vào lúc 22/12/2022 tại 11:22, NTHAHT đã nói:

Gửi bạn bản này đầy đủ hơn. Hiệu chỉnh khe hở thì ở chỗ số 1 màu đỏ.

(defun c:BR2  (/ *error* cmd ent khe poi sel)
  (defun *error* (msg) (setvar 'CMDECHO cmd) (princ msg) (princ))
  (setq cmd (getvar 'CMDECHO)
        khe 1)
  (setvar 'CMDECHO 0)
  (while (and (setq sel (entsel "\nChon vi tri Break: "))
              (wcmatch (cdr (assoc 0 (entget (setq ent (car sel))))) "*LINE")
              (setq poi (vlax-curve-getClosestPointTo ent (cadr sel))))
    (apply 'vl-cmdf
           (apply 'append
                  (cons (list "break" ent)
                        (mapcar '(lambda (x)
                                   (list "_none"
                                         (vlax-curve-getPointAtDist ent
                                                                    (+ (vlax-curve-getDistAtPoint ent poi) (* x 0.5 khe)))))
                                '(-1 1))))))
  (setvar 'CMDECHO cmd)
  (princ))

Bác ơi, lệnh rất ok rồi, nhưng hiện e đang dùng thì e thấy nó ko break được đường tròn, hình như chỉ break được đường thằng và đường chéo hay sao ý. Làm sao để nó break dc đường tròn hay cung tròn hả bác? có sửa dc ko bác? em cảm ơn!

[NTHAHT 53]

Chỗ này: "*LINE"

Bạn sửa lại như sau: "ARC,CIRCLE,*LINE"

Là được.

[Victory8x 0]

5 phút trước, NTHAHT đã nói:

Chỗ này: "*LINE"

Bạn sửa lại như sau: "ARC,CIRCLE,*LINE"

Là được.

Quá ok rồi. Cảm ơn bác rất nhiều!!!

[tung89gt 0]

Vào lúc 28/12/2022 tại 09:44, NTHAHT đã nói:

Chỗ này: "*LINE"

Bạn sửa lại như sau: "ARC,CIRCLE,*LINE"

Là được.

Bác cho em hỏi thêm là có thể sửa lisp thành Break nhiều pline cùng giao với 1 pline "A"  tại điểm  giao với Pline "A" được không? Em cảm ơn bác