Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
phongtran86

[yêu cầu] Lisp vẽ hình chữ nhật

Các bài được khuyến nghị

phongtran86    21
duy782006    1.372

Muốn ra thì dương mà muốn vô thì âm.

Lệnh VHCN.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi rectang
;;;Cu phap su dung (duy:t_rectang toadoa toadob kieu tile Layer Color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_rectang (diema diemb dorong tl stl La Co)


(setq toado (list diema (list (car diema) (cadr diemb)) diemb (list (car diemb) (cadr diema)) ))

(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= tl "") (setq tl "bylayer") ))
(cond ((= stl "") (setq stl 1) ))


(setq Lst
  (list
   (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
   (cons 8 la)
   (cons 6 tl)
   (cons 48 stl)
   (cons 62 co)
   (cons 100 "AcDbPolyline")
   (cons 43 dorong)
   (cons 90 4)
   (cons 70 1)))
(setq x 0)
(repeat 4
  (setq Lst (append Lst (list (cons 10 (nth x toado)) )))
  (setq x (1+ x)))
(entmakex Lst)
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh gia tri so neu chua co thi gan cho gia tri mac dinh
;;;Cu phap su dung (duy:xd_gts gtn gtmd mdich)
;;;Gia tri tra ve la so gtn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)



(defun c:vhcn (/ diemm diemh diema diemb)
(setq diemm (getpoint "\nDiem thu nhat:"))
(setq diemh (getpoint "\nDiem thu hai:"))
(duy:t_rectang diemm diemh 0 "" "" "" "")
(setq khoang (duy:xd_gts khoang 110 "Khoang cach offset: "))
(setq diema (polar diemm pi khoang))
(setq diema (polar diema (/ (* pi 3) 2) khoang))
(setq diemb (polar diemh (* 2 pi) khoang))
(setq diemb (polar diemb (/ pi 2) khoang))
(duy:t_rectang diema diemb 0 "" "" "" "")
(princ))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phongtran86    21

cảm ơn bác. Khi vẽ như thế thi em không muốn có hcn của pick1, pick2 mà chỉ có của offset thôi. Với lại  Khi ta vẽ 2 đỉnh từ cung phần tư thứ 2 sang cung phần tư thứ 4 thi hình chữ nhật ko đc như ý. Bác fix dc thi tốt quá21028_h2.png

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Code của bạn đây :

 

 
(DEFUN C:vhcn(/ p1 p2 pside kcach el)
  (setvar "cmdecho" 0)
  (COMMAND "RECTANG" "_non" (SETQ P1 (GETPOINT "\nPICK DIEM 1 :")) "_non"(setq p2 (GETPOINT p1 "\npICK DIEM 2 :")))
  (if (< (setq kcach (getreal "\nKhoang cach offset :")) 0)
    (setq pside (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
    (setq pside (polar p1 (angle p2 p1) (/ (distance p1 p2) 2.0)))
  )(setq el (entlast))
  (COMMAND "OFFSET" (abs kcach) el "_non" pside "e")
  (command "erase" el "")
)
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.676

Thích ngắn thì đây nữa!


 

(defun C:HA( / p1 p3 kc p1x p3x)
 (setq p1 (getpoint "\nPick diem 1: "))
 (setq p3 (getcorner p1 "\nPick diem 2: "))
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
 (setq p1x (list (+ (min (car p1) (car p3)) kc) (+ (min (cadr p1) (cadr p3)) kc))
       p3x (list (- (max (car p1) (car p3)) kc) (- (max (cadr p1) (cadr p3)) kc)))
 (command "rectang" "non" p1x "non" p3x))
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Thích ngắn hơn thì đây nữa :

 

 
(defun c:vhcn(/ p1 p2 dis)
  (setvar "cmdecho" 0)
 (or kc (setq kc 110))
 (setq kc (cond ((getdist (strcat "\nKhoang cach offset <" (rtos kc 2 2) ">:"))) (kc)))
  (command "rectang" (setq p1 (getpoint "\n Diem thu 1 :")) (setq p2 (getcorner p1 "\n Diem thu 2 :")))
  (setq dis (/ (distance p1 p2) 2.0))
  (command "scale" "l" "" "_non" (polar p1 (angle p1 p2) dis) (abs (/ (+ dis (* kc (sqrt 2))) dis)))
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Sao mà scale theo 2 phương như nhau được bác Tue_NV ơi? HCN chứ phải vuông đâu!

 

Ý da! nhầm, thanks bác

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.676

hi hi. Bac tue bi bat lỗi :))

Xin lỗi bác Tue_NV, tôi xin trả lời thay:

Sơ ý trong khi code lisp là chuyện thường ngày ở... forum bạn à! Ai không sơ ý mới lạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
duy782006    1.372

Các bác cũng đã làm lisp mới rồi. Nhưng mình cũng sửa phát cho nó vui.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi rectang
;;;Cu phap su dung (duy:t_rectang toadoa toadob kieu tile Layer Color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_rectang (diema diemb dorong tl stl La Co)


(setq toado (list diema (list (car diema) (cadr diemb)) diemb (list (car diemb) (cadr diema)) ))

(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= tl "") (setq tl "bylayer") ))
(cond ((= stl "") (setq stl 1) ))


(setq Lst
  (list
   (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
   (cons 8 la)
   (cons 6 tl)
   (cons 48 stl)
   (cons 62 co)
   (cons 100 "AcDbPolyline")
   (cons 43 dorong)
   (cons 90 4)
   (cons 70 1)))
(setq x 0)
(repeat 4
  (setq Lst (append Lst (list (cons 10 (nth x toado)) )))
  (setq x (1+ x)))
(entmakex Lst)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh diem duoi trai va tren phai tu hai diem a va b
;;;Cu phap su dung (duy:xd_dttp<diemdiem diema diemb )
;;;Gia tri tra ve la list diem duoi ben trai va diem tren ben phai
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_dttp<diemdiem (a b / a b xtr xph ytr ydu trd ptr lkq)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq xtr (min (car a) (car b)))
(setq xph (max (car a) (car b)))
(setq ytr (max (cadr a) (cadr b)))
(setq ydu (min (cadr a) (cadr b)))
(setq trd (list xtr ydu))
(setq ptr (list xph ytr))
(setq lkq (list trd ptr))
(setvar "osmode" luubatdiem)
lkq)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Xac dinh gia tri so neu chua co thi gan cho gia tri mac dinh
;;;Cu phap su dung (duy:xd_gts gtn gtmd mdich)
;;;Gia tri tra ve la so gtn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:xd_gts (gtn gtmd mdich / gtn gtmd mdich)
(or gtn (setq gtn gtmd))
(setq gtn (cond ((getreal (strcat "\n" mdich " < " (rtos gtn 2 2) " >:")))(gtn)))
gtn)



(defun c:vhcn (/ diemm diemh diema diemb)
(setq diemm (getpoint "\nDiem thu nhat:"))
(setq diemh (getpoint "\nDiem thu hai:"))
(setq trao (duy:xd_dttp<diemdiem diemm diemh))
(setq diemm (car trao))
(setq diemh (cadr trao))
(setq khoang (duy:xd_gts khoang 110 "Khoang cach offset: "))
(setq diema (polar diemm pi khoang))
(setq diema (polar diema (/ (* pi 3) 2) khoang))
(setq diemb (polar diemh (* 2 pi) khoang))
(setq diemb (polar diemb (/ pi 2) khoang))
(duy:t_rectang diema diemb 0 "" "" "" "")
(princ))

 

Mình dùng biện pháp củ chuối là làm 1 hàm cứ nhập vào 2 điểm kiểu gì thì kiểu nó cũng ném lại cho hai điểm theo thứ tự điểm dưới bên trái và điểm trên bên phải he he.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nhờ mọi người giúp đỡ viết lisp vẽ hình chữ nhật, chương trình sẽ hỏi chiều rộng (W) và chiều cao (H) hình chữ nhật. Khi vẽ thì cad chỉ cần vẽ ra theo chiều rộng mà chương trình đã hỏi,chiều dài là do mình click chuột trên bản vẽ, không cần chiều cao. Vẽ xong sẽ xuất text WxH với chiều cao chữ sẽ được chương trình lisp hỏi (vẽ lần sau thì chương trình tự nhớ chiều cao chữ,nếu muốn thay đổi thì mình mới đánh lại chiều cao chữ

 

 Cám ơn nhiều!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×