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.
Đăng nhập để thực hiện theo  
Doan Van Ha

[Đã xong] Lisp vẽ Circle, Ellipse, Rectang kiểu rút gọn

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

Doan Van Ha    2.680

Chúc mừng năm mới 2014 !

Nhân dịp năm mới 2014, xin gởi các bạn món quà Xuân là 3 lisp vẽ Circle, Ellipse, Rectang theo kiểu rút gọn.

Các lisp này không thay thế các lệnh gốc, nhưng nó sử dụng gọn hơn nếu như nhu cầu của các bạn chỉ là đơn giản như các lisp.

Lisp 1: vẽ nhiều Circle liên tục với Radius cố định và tâm thay đổi.

Cú pháp ví dụ: CR125 (vẽ các Circle có Radius bằng 125)

 

;; Lenh Circle rut gon.
;; Doan Van Ha - CadViet.com - 31/12/2013
;----- Circle_Radius (by HA). Draw Circle voi Radius co dinh, Center tu chon. Nhap lenh theo cau truc: CR10, CR125, CR1.5 ...
(vl-load-com)
(if (null circle_reactor) (setq circle_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . Circle_HA)))))
(defun Circle_HA (a b / cmd)
 (and
  (wcmatch (setq cmd (strcase (nth 0 b))) "CR*")
  (setq rad (distof (substr cmd 3)))
  (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "Circle1 "))
 (princ))
(defun Circle1( / p osm)
 (setvar "cmdecho" 0) (setq osm (getvar "osmode"))
 (while (setq p (getpoint "\nSpecify center point: "))
  (setvar "osmode" 0)
  (vl-cmdf "circle" p rad)
  (setvar "osmode" osm)))
(vlax-add-cmd "Circle1" 'Circle1)
 
  • Vote tăng 7

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.680

Lisp 2: vẽ nhiều Ellipse liên tục với 2 bán trục (// OX và // OY) cố định và tâm thay đổi.

Cú pháp ví dụ: R20C30 (vẽ các Ellipse có bán trục Rộng theo OX là 20, bán trục Cao theo OY là 30)

 

;; Lenh Ellipse rut gon.
;; Doan Van Ha - CadViet.com - 31/12/2013
;----- Ellipse_MajorAxis_MinorAxis (by HA). Draw Ellipse voi Radius Major Axis va Minor Axis co dinh, Center tu chon.  Nhap lenh theo cau truc 2 ban truc: R100C50 ...
(vl-load-com)
(if (null ellipse_reactor) (setq ellipse_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . Ellipse_HA)))))
(defun Ellipse_HA (a b / cmd)
 (defun #String:Get-Numbers(str) ((lambda (l) (read (strcat "(" (vl-list->string (mapcar '(lambda (a b c) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58))) b 32)) (cons nil l) l (append (cdr l) (list nil)))) ")" ))) (vl-string->list str)))
 (and
  (wcmatch (setq cmd (strcase (nth 0 b))) "R*C*")
  (setq rong (car (#String:Get-Numbers cmd)))
  (setq cao (cadr (#String:Get-Numbers cmd)))
  (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "Ellipse1 "))
 (princ))
(defun Ellipse1( / p osm)
 (setvar "cmdecho" 0) (setq osm (getvar "osmode"))
 (while (setq p (getpoint "\nSpecify center point: "))
  (setvar "osmode" 0)
  (vl-cmdf "ellipse" "c" p (polar p 0 rong) (polar p (/ pi 2) cao))
  (setvar "osmode" osm)))
(vlax-add-cmd "Ellipse1" 'Ellipse1)
 
  • Vote tăng 6

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.680

Lisp 3: vẽ nhiều Rectang liên tục với chiều rộng và chiều cao cố định và tâm thay đổi hoặc hướng của điểm corner thay đổi.

Cú pháp ví dụ: W40H50 (vẽ các Rectang có Width theo OX là 40Height theo OY là 50)

 

;; Lenh Rectang rut gon.
;; Doan Van Ha - CadViet.com - 31/12/2013
;----- Rectangle_Width+Height (by HA). Draw Rectangle voi Width va Height co dinh, 2 diem Corner de xac dinh huong, hoac Center tu chon. Nhap lenh theo cau truc: W100H50 ...
(vl-load-com)
(if (null rectang_reactor) (setq rectang_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . Rectang_HA)))))
(defun Rectang_HA (a b / cmd #String:Get-Numbers)
 (defun #String:Get-Numbers(str) ((lambda (l) (read (strcat "(" (vl-list->string (mapcar '(lambda (a b c) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58))) b 32)) (cons nil l) l (append (cdr l) (list nil)))) ")" ))) (vl-string->list str)))
 (and
  (wcmatch (setq cmd (strcase (nth 0 b))) "W*H*")
  (setq wid (car (#String:Get-Numbers cmd)))
  (setq hei (cadr (#String:Get-Numbers cmd)))
  (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "Rectang1 "))
 (princ))
(defun Rectang1( / p q pt ang osm)
 (setvar "cmdecho" 0) (setq osm (getvar "osmode"))
 (while
  (and
   (not (initget "c"))
   (setq p (getpoint "\nSpecify first corner point or [Center]: "))
   (if (= 'STR (type p))
    (and
     (setq pt (getpoint "\nSpecify center point for rectang: "))
(setq p (list (- (car pt) (/ wid 2.)) (- (cadr pt) (/ hei 2.))))
(setq q (list (+ (car pt) (/ wid 2.)) (+ (cadr pt) (/ hei 2.)))))
(and
     (setq q (getpoint p "\nSpecify point to the direction of other corner: "))
     (not (equal (car p) (car q) 1E-8)) (not (equal (cadr p) (cadr q) 1E-8))
     (setq ang (angle p q))
     (setq q
      (cond
       ((< 0 ang (* 0.5 pi)) (list (+ (car p) wid) (+ (cadr p) hei)))
       ((< (* 0.5 pi) ang pi) (list (- (car p) wid) (+ (cadr p) hei)))
       ((< pi ang (* 1.5 pi)) (list (- (car p) wid) (- (cadr p) hei)))
       ((< (* 1.5 pi) ang (* 2 pi)) (list (+ (car p) wid) (- (cadr p) hei))))))))
  (setvar "osmode" 0)
  (if (and p q) (vl-cmdf "Rectang" p q))
  (setvar "osmode" osm)))
(vlax-add-cmd "Rectang1" 'Rectang1)
 
  • Vote tăng 5

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
nguyenbd1    13

quá hay bác hà ơi... hay nhất là lisp cr*. e xjn hỏj bác gjờ em mún vẽ dt bằng cách nhâp d.kjnh chứ ko phảj là bkjnh thj sua nhu the nào hả 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.680

Bạn sửa như thế này để vẽ theo đường kính:

(vl-cmdf "circle" p rad)

Thành:

(vl-cmdf "circle" p (/ rad 2.))

Hoặc để khỏi sửa lisp, ví dụ muốn vẽ circle có đường kính 100 thì bạn nhập CR50.

 

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.680

Bác hoành oi. Rât cảm ơn bác. Có tối ưu dc nửa ko bak. Ý e la thay vj gõ cr* gjờ chỉ gõ c*.

Vì tôi viết nhiều lệnh kiểu này nên sợ có thể bị trùng nhau mà đành dùng tới 2 ký tự "C" và "R".

Nếu bạn chỉ dùng mỗi lisp vẽ Circle thì có thể sửa 2 chỗ này, chứ tôi không sửa lisp đã post:

1). Sửa CR* thành C*

2). Sửa số 3 thành số 2

Bác Hoành là bác nào vậy ta?

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

Chào bạn Khuatduyluong!

 

Mình trước đó đã viết bài trả lời cho bạn. Nhưng vì thấy lạc chủ đề nên xóa đi rồi.

Với bài toán của bạn thì chỉ cần dùng 1 lệnh CAD là xong

Có điều, bạn nên post vào chủ đề khác để không bị loãng chủ đề của bác Ha nhé. Mình sẽ trả lời cho bạn

Và không viết bài có nội dung khác chủ đề của topic này vào đây nhé!

 

Thanks All! 

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

@All: Tôi sẽ xoá các bài viết không liên quan đến chủ đề của topic này 

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

Chào bạn Khuatduyluong!

 

Mình trước đó đã viết bài trả lời cho bạn. Nhưng vì thấy lạc chủ đề nên xóa đi rồi.

Với bài toán của bạn thì chỉ cần dùng 1 lệnh CAD là xong

Có điều, bạn nên post vào chủ đề khác để không bị loãng chủ đề của bác Ha nhé. Mình sẽ trả lời cho bạn

Và không viết bài có nội dung khác chủ đề của topic này vào đây nhé!

 

Thanks All! |

Chỉ cần dùng một lệnh Cad thôi ah? Vậy thì dù bài toán của mình đã giải quyết xong mình cũng sẽ lập một topic riêng. Cũng sorry Bác Ha vì đã chèn nội dung của mình vào topic của bác bởi vì khi đọc đến mình thấy có chút ít liên quan nên post luôn.

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

Đăng nhập để thực hiện theo  

×