[Trợ giúp] - Lisp đánh cấp (Khi dùng trên cad 2021 bị rời rạc không thành 1 đường)

[Lâm Vũ 3]

Em chào mọi người ạ!. Em có sưu tầm được 1 lisp đánh cấp, khi trên cad 2021 bị rời rạc thành các đường line mong anh chị sửa em để khi dùng lisp xong nó nối liền thành đường pline với ạ. Dùng với các cad đời thấp thì nó ok nhưng không hiểu sao khi em dùng trên cad 2021 lại bị ạ. Mong các anh chị giúp đỡ em với ạ! Em cảm ơn ạ! Chúc anh chị thật nhiều sức khỏe và thành công!

 - Lệnh tắt DCR đánh với chiều rộng; DCC với chiều cao.

 

(defun c:dcr (/ cur B sp ep Lx n po1 po2 po3 i oldos ans ss )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq cur (car (entsel "\n Ban Pick chon Pline :")) 
         ss (ssadd))
(while (null cur) 
       (setq cur (car (entsel "\n Ban Pick chon lai Pline :")))
)
(setq B (getdist "\n Nhap be rong danh cap :"))
(initget "T D")    
(setq ans (getkword "\n Ban danh cap Tren hay Duoi duong pline < T / D > :"))
(setq sp (vlax-curve-getStartPoint cur))
(setq ep (vlax-curve-getEndPoint cur))
(if (> (car sp) (car ep))
(progn            
(setq ep (vlax-curve-getStartPoint cur))            
(setq sp (vlax-curve-getEndPoint cur))        
)
)
(setq Lx (abs (- (car ep) (car sp)) ))
(setq n (abs(fix (/ (- Lx (rem Lx b )) b ))) i 1)
(setq po1 sp)
(Repeat n
    (setq dvi (list (+ (car sp) (* i b )) (cadr sp) 0))
    (command "Xline" "Ver" dvi "")
    (setq po3 (car (giaodt cur (entlast))) )
    (entdel (entlast))
    (if  (= ans "D") 
         (if (> (cadr po3) (cadr po1))
             (setq po2 (list (car po3) (cadr po1) 0))
             (setq po2 (list (car po1) (cadr po3) 0))
         )
         (if (< (cadr po3) (cadr po1))
              (setq po2 (list (car po3) (cadr po1) 0))
              (setq po2 (list (car po1) (cadr po3) 0))
         )
    )
    (setq ss (ssadd (dline po1 po2) ss))
    (setq ss (ssadd (dline po2 po3) ss))
    (setq po1 po3)
    (setq i (1+ i))
)
(if (= ans "D" )
     (if (> (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
     (if (< (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
)
(setq ss (ssadd (dline po1 po2) ss))
(setq ss (ssadd (dline po2 ep)  ss))
(command "pedit" "m" ss "" "Y" "j" "0" "")
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
);
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dcc (/ cur B sp ep Lx n po1 po2 po3 i oldos ans ss )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq cur (car (entsel "\n Ban Pick chon Pline :")) 
         ss (ssadd))
(while (null cur) 
       (setq cur (car (entsel "\n Ban Pick chon lai Pline :")))
)
(setq B (getdist "\n Nhap chieu cao danh cap :"))
(initget "T D")    
(setq ans (getkword "\n Ban danh cap Tren hay Duoi duong pline < T / D > :"))
(setq sp (vlax-curve-getStartPoint cur))
(setq ep (vlax-curve-getEndPoint cur))
(if (> (cadr sp) (cadr ep))
(progn            
(setq ep (vlax-curve-getStartPoint cur))            
(setq sp (vlax-curve-getEndPoint cur))        
)
)
(setq Lx (abs (- (cadr ep) (cadr sp)) ))
(setq n (abs(fix (/ (- Lx (rem Lx b )) b ))) i 1)
(setq po1 sp)
(Repeat n
    (setq dvi (list  (car sp) (+ (* i b ) (cadr sp)) 0))
    (command "Xline" "Hor" dvi "")
    (setq po3 (car (giaodt cur (entlast))) )
    (entdel (entlast))
    (if  (= ans "D") 
         (if (> (cadr po3) (cadr po1))
             (setq po2 (list (car po3) (cadr po1) 0))
             (setq po2 (list (car po1) (cadr po3) 0))
         )
         (if (< (cadr po3) (cadr po1))
              (setq po2 (list (car po3) (cadr po1) 0))
              (setq po2 (list (car po1) (cadr po3) 0))
         )
    )
    (setq ss (ssadd (dline po1 po2) ss))
    (setq ss (ssadd (dline po2 po3) ss))
    (setq po1 po3)
    (setq i (1+ i))
)
(if (= ans "D" )
     (if (> (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
     (if (< (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
)
(setq ss (ssadd (dline po1 po2) ss))
(setq ss (ssadd (dline po2 ep)  ss))
(command "pedit" "m" ss "" "Y" "j" "0" "")
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
);
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dline(p1 p2)
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))));
(defun GiaoDT (ent1 ent2)
(setq ob1 (vlax-ename->vla-object ent1)
         ob2 (vlax-ename->vla-object ent2))
(setq g (vlax-variant-value(vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil))
(if g
(progn
(setq kq nil
          sd (fix (/ (length g) 3)))
(repeat sd
      (setq kq (append kq (list (list (car g) (cadr g) (caddr g)))) 
                g (cdddr g))
)
kq
)
nil
)
)
;;;

[Duong Nhat Duy 484]

Bạn nhập PEDITACCEPT 0 là được.

[Lâm Vũ 3]

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

Bạn nhập PEDITACCEPT 0 là được.

Em cám ơn anh nhiều ạ!

[trieubb 9]

không thì sửa dòng này:

(command "pedit" "m" ss "" "Y" "j" "0" "")

thành:

(command "pedit" "m" ss "" "j" "0" "")

[tannguyen291 174]

phải như thế này mới tròn chứ:

(if (= (getvar 'PEDITACCEPT) 0)

    (command "pedit" "m" ss "" "Y" "j" "0" "")

    (command "pedit" "m" ss "" "j" "0" "")

)

Thực ra người viết ngay từ đầu lập danh sách point rồi cuối cùng entmake pline sẽ sạch nhất

[Lâm Vũ 3]

Vào lúc 31/7/2025 tại 14:13, trieubb đã nói:

không thì sửa dòng này:

(command "pedit" "m" ss "" "Y" "j" "0" "")

thành:

(command "pedit" "m" ss "" "j" "0" "")

em cám ơn ạ! 

[Lâm Vũ 3]

Vào lúc 31/7/2025 tại 16:44, tannguyen291 đã nói:

phải như thế này mới tròn chứ:

(if (= (getvar 'PEDITACCEPT) 0)

    (command "pedit" "m" ss "" "Y" "j" "0" "")

    (command "pedit" "m" ss "" "j" "0" "")

)

Thực ra người viết ngay từ đầu lập danh sách point rồi cuối cùng entmake pline sẽ sạch nhất

em cảm ơn ạ!