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

Tính diện tích 1 miền bằng pick điểm

Bởi thichmacarong , trong AutoLisp

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

vcdichoi    7

vcdichoi
Đã đăng
Vào lúc 3/11/2010 tại 08:57, duyanhhcm đã nói:

- Bác chưa tìm kỹ, chứ trên diễn đàn đã post rùi đấy thui. Đáp ứng cho bác 3 việc:

1. Pick chọn 1 điểm trong vùng muốn tính diện tích, vùng chọn (nếu kín) sẽ được tô Hatch

2. Có thể chọn tỷ lệ bất kỳ. Tỷ lệ này có thể thay đổi bất kỳ lúc nào và lưu đến lần chạy sau.

3. Muốn xuất kết quả lẻ 0.0 hay 0.0000 cũng được. Việc này cũng có thể thay đổi bất kỳ lúc nào.

- Bác tải và xem hướng dẫn để cài đặt nhé, gõ lệnh DDT để tính diện tích:

- Install: http://www.mediafire.com/file/z43aajcmjtz/DUYLISP.exe

- Hướng dẫn: http://www.mediafire.com/file/h3rwqf2nqn0/Huong dan cai dat DuyLisp.doc

Cháu chào chú!

Cháu thực hiện 3  lệnh trong Lisp là "2d, dtich, chuvi" đều được nhưng chỉ có lệnh "dtichp" trong Lisp đó thì không được và có kết quả như hình dưới.

Mong chú và các anh/chị trên diễn đàn giúp cháu khắc phục lỗi khi gọi lệnh  "dtichp" .

Cháu cảm ơn!

111.png

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

vcdichoi    7

vcdichoi
Đã đăng
Vào lúc 21/6/2010 tại 07:53, dkkx3a đã nói:

 

Đây bạn, nhưng mình nghĩ có thể chỉnh sửa qua lệnh UN vẫn cơ động hơn.

Sửa hộ bạn:

http://www.cadviet.com/upfiles/2/tdt_1_sole.lsp

 

Anh ơi có thể giúp em chỉnh code để có thể khai báo tỷ lệ nếu muốn.

Như Lisp trên muốn khai báo tỷ lệ lại phải thoát file và khởi động lại.

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

duy782006
Đã đăng

Thêm 1 lệnh ddvt. khi nào ưng đổi thì gỏ lệnh DDVT rồi nhập số mới vào.

(defun c:ddvt ()

(setq tl (getreal "\nDrawing scale : ")

(princ))

  • Like 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

vcdichoi    7

vcdichoi
Đã đăng
14 phút trước, duy782006 đã nói:

Thêm 1 lệnh ddvt. khi nào ưng đổi thì gỏ lệnh DDVT rồi nhập số mới vào.

(defun c:ddvt ()

(setq tl (getreal "\nDrawing scale : ")

(princ))

Cháu cảm ơn chú!

Cháu thêm dòng lệnh chú viết giúp, nhưng không biết đã thêm đúng vị trí hay còn sai ở chỗ nào mà khi gọi lệnh "ddvt" chưa thấy có tác dụng

Nhờ Chú xem giúp lại cháu với ạ!

Code của lisp sau khi cháu đã thêm vào :

Quote


(princ "\nBAN DANG DUNG CHUONG TRINH AUTOLISP CUA CTY NAM DO")
(princ "\nCHUONG TRINH TINH DIEN TICH HINH KIN - CAU LENH SU DUNG CHUONG TRINH LA: TDT - WRITE BY NGUYEN THANH TAM - KSCD")
(defun DXF (code elist)
  (cdr (assoc code elist))
);dxf
(defun DXF (code elist)
  (cdr (assoc code elist))
);dxf
(defun c:ddvt ()
(setq tl (getreal "\nDrawing scale : ")
(princ))
(defun c:tdt(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
    (prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (command "layer" "n" "Dientich20" "c" "6" "Dientich20" "")
    (command "layer" "s"  "Dientich20" "" "")
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
     
    (command "text" "m" pt2  "0" (rtos dtl 2 (getvar "luprec")))
    (command "text" "m" pt2 "1.5" "0" (strcat (rtos dtl  2 (getvar "luprec")) "m2"))

  );if
  (princ)
);defun q
;------------------------------------------------------------------------

  

(defun c:zz(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
      (setq dtl2 (/ dtl 40))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
    (command "text" pt2  "90" (rtos dtl2 2 (getvar "luprec")))
    (command "text" pt2 "2" "0" (strcat (rtos dtl2  2 (getvar "luprec")) ))

  );if
  (princ)
);defun zz
;----------
(defun c:xx(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
      (setq dtl2 (/ dtl 70))
  (setq dtl3 (+ dtl2 0))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
    (command "text" pt2  "90" (rtos dtl3 2 (getvar "luprec")))
    (command "text" pt2 "1" "90" (strcat (rtos dtl3  2 (getvar "luprec")) ))

  );if
  (princ)
);defun xx
;--
 

 

 

bbbb.png

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

duy782006    1.551

duy782006
Đã đăng

Ờ xin lỗi. lúc nảy viết thiếu 1 dấu )

(defun c:ddvt ()

(setq tl (getreal "\nDrawing scale : "))

(princ))

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

vcdichoi    7

vcdichoi
Đã đăng
2 giờ trước, duy782006 đã nói:

Thêm 1 lệnh ddvt. khi nào ưng đổi thì gỏ lệnh DDVT rồi nhập số mới vào.

(defun c:ddvt ()

(setq tl (getreal "\nDrawing scale : ")

(princ))

Cháu cảm ơn chú!

Cháu thêm dòng lệnh chú viết giúp, nhưng không biết đã thêm đúng vị trí hay còn sai ở chỗ nào mà khi gọi lệnh "ddvt" chưa thấy có tác dụng

Nhờ Chú xem giúp lại cháu với ạ!

Code của lisp sau khi cháu đã thêm vào :

Quote


(princ "\nBAN DANG DUNG CHUONG TRINH AUTOLISP CUA CTY NAM DO")
(princ "\nCHUONG TRINH TINH DIEN TICH HINH KIN - CAU LENH SU DUNG CHUONG TRINH LA: TDT - WRITE BY NGUYEN THANH TAM - KSCD")
(defun DXF (code elist)
  (cdr (assoc code elist))
);dxf
(defun DXF (code elist)
  (cdr (assoc code elist))
);dxf
(defun c:ddvt ()
(setq tl (getreal "\nDrawing scale : ")
(princ))
(defun c:tdt(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
    (prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (command "layer" "n" "Dientich20" "c" "6" "Dientich20" "")
    (command "layer" "s"  "Dientich20" "" "")
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
     
    (command "text" "m" pt2  "0" (rtos dtl 2 (getvar "luprec")))
    (command "text" "m" pt2 "1.5" "0" (strcat (rtos dtl  2 (getvar "luprec")) "m2"))

  );if
  (princ)
);defun q
;------------------------------------------------------------------------

  

(defun c:zz(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
      (setq dtl2 (/ dtl 40))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
    (command "text" pt2  "90" (rtos dtl2 2 (getvar "luprec")))
    (command "text" pt2 "2" "0" (strcat (rtos dtl2  2 (getvar "luprec")) ))

  );if
  (princ)
);defun zz
;----------
(defun c:xx(/ dtl dtcon pt1 pt2 ss et oslast vsize)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale : "))
;    (setq ntl (/ 1 tl))
;    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
   (setq ntl (/ 1 tl))
   (setq tl2 (* ntl ntl))

  (print)
  (print)
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 50))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (/ (getvar "AREA") tl2))
    (setq dtl (+ dtcon dtl))
      (setq dtl2 (/ dtl 70))
  (setq dtl3 (+ dtl2 0))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
    (print)
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (print)
  (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
  (print)
  (setq pt2 (getpoint "\nPoint to write: "))
  (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
    (command "text" pt2  "90" (rtos dtl3 2 (getvar "luprec")))
    (command "text" pt2 "1" "90" (strcat (rtos dtl3  2 (getvar "luprec")) ))

  );if
  (princ)
);defun xx
;--
 

 

Dạ! được rồi chú ạ!

cháu cảm ơn chú 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

lephuocly    7

lephuocly
Đã đăng
Vào lúc 11/6/2007 tại 12:04, Nguyen Hoanh đã nói:

Theo đúng yêu cầu, bạn thử xem nhé!

lệnh là DTM (diện tích miền)

  


(defun c:dtm()
 (defun ctext (diem gt / lst)    
   (setq lst
   (list
     (cons 0 "TEXT")
     (cons 1 gt)
     (cons 10 diem)
     (cons 40 (getdist p "\nChieu cao chu: "))
   )
   )
   (entmake lst)
 )
 (defun dtdoituong (entdt /)
   (command ".area" "o" entdt)
   (command ".erase" entdt "")
   (getvar "area")
 )
 (defun getbound(p)
   (setq ent (entlast))
   (command ".boundary" "A" "B" "E" "I" "Y" "" p "")
   (setq ent1 (entlast))
   (cond
     ((eq ent ent1) nil)
     (t ent1)
   )
 )
 (setq
   p (getpoint "\nVao diem can tinh dien tich: ")
   entpl (getbound p)	
 )
 (if entpl
   (ctext p (rtos (dtdoituong entpl)))
   (alert "Diem ban chon khong kin!")
 )
 (princ)
)
 

 

 

Lisp trên rất cơ bản, chỉ tính đúng với các miền không có "lỗ thủng".

Không được bác ơi ! nó báo miền không kín, mặc dù tôi vẽ dùng thử co hình tròn. Bác xem lại dùm 

  • Vote giảm 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

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
Về Đầu Trang AutoLisp
×