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  
beba

[Đã xong] lisp tính Diện tích

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

beba    0

Lisp tính diện tích thì rất nhiều nhưng em thấy cái lisp tính DT này dùng được, em thích.

nhưng nó vẫn bắt nhập tỉ lệ bản vẽ sau mỗi lần lặp lại, với lại không có phần nhập cao chữ

Nhờ mấy anh sửa lại dùm em :

- Thêm phần nhập cao chữ

- Chỉ nhập tỉ lệ bản vẽ lúc đầu, những lần sau không cần nhập nữa

Cảm ơn

 

 

(Defun c:n ()
(setvar "cmdecho" 0)
(command "osnap" "none")
(setq tl (getreal "\n Ti le ban ve  1: "))

(setq r 50 )
(repeat r 
(setq pt (getpoint "\n Pick point : "))
(setq am (* tl tl))
(setq s 0)

(progn
(while pt
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "boundary" pt "")
(setq entnew (cdr (assoc 5 (entget (entlast)))))
(if (/= entold entnew)
(progn
(setq entnew (entget (entlast)))
(if (assoc 62 entnew)
(setq
entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew))))
(assoc 62 entnew)
entnew
)
)
(setq entnew
(append
entnew
(list
(cons
62
(+ 3
(cdr
(assoc 62
(tblsearch	"layer"
(cdr (assoc 8 entnew))
)
)
)
)
)
)
)
)
)


(entmod entnew)
(Command "area" "o" (entlast))
(setq s (+ s (getvar "area")))
(setq pt (getpoint "\n Pick point: "))
(entdel (entlast))
)
(progn
(princ "Error Wrong Point")
(setq pt (getpoint "\n Pick point: "))
)
)
)

)

(setq pt1 (getpoint "\nPick any point to draw area : "))
(setq dt (/ (* s am) 1000000))
(setq dt (strcat (rtos dt 2 2) "m²"))


(Setq ldt (Getstring t "\n Kind of area : "))
(cond

)
(command "text" pt1 2.0 0 (strcat ldt dt))

))

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
phamthanhbinh    3.123

Lisp tính diện tích thì rất nhiều nhưng em thấy cái lisp tính DT này dùng được, em thích.

nhưng nó vẫn bắt nhập tỉ lệ bản vẽ sau mỗi lần lặp lại, với lại không có phần nhập cao chữ

Nhờ mấy anh sửa lại dùm em :

- Thêm phần nhập cao chữ

- Chỉ nhập tỉ lệ bản vẽ lúc đầu, những lần sau không cần nhập nữa

Cảm ơn

 

Hề hề hề,

Bạn dùng thử cái ni xem sao hỉ???


(Defun c:n ()
(setvar "cmdecho" 0)
(command "osnap" "none")
(if  (= tl nil)
(setq tl (getreal "\n Ti le ban ve  1: "))
)
(setq r 50 )
(repeat r 
(setq pt (getpoint "\n Pick point : "))
(setq am (* tl tl))
(setq s 0)

(progn
(while pt
(setq entold (cdr (assoc 5 (entget (entlast)))))
(command "boundary" pt "")
(setq entnew (cdr (assoc 5 (entget (entlast)))))
(if (/= entold entnew)
(progn
(setq entnew (entget (entlast)))
(if (assoc 62 entnew)
(setq
entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew))))
(assoc 62 entnew)
entnew
)
)
(setq entnew
(append
entnew
(list
(cons
62
(+ 3
(cdr
(assoc 62
(tblsearch	"layer"
(cdr (assoc 8 entnew))
)
)
)
)
)
)
)
)
)


(entmod entnew)
(Command "area" "o" (entlast))
(setq s (+ s (getvar "area")))
(setq pt (getpoint "\n Pick point: "))
(entdel (entlast))
)
(progn
(princ "Error Wrong Point")
(setq pt (getpoint "\n Pick point: "))
)
)
)

)

(setq pt1 (getpoint "\nPick any point to draw area : "))
(setq dt (/ (* s am) 1000000))
(setq dt (strcat (rtos dt 2 2) "m²"))
(setq h0 2)
(setq ht (getreal "\n Nhap chieu cao text: "))
(if (= ht nil)
    (setq ht h0)
    (setq h0 ht)
)

(Setq ldt (Getstring t "\n Kind of area : "))
(cond

)
(command "text" pt1 ht 0 (strcat ldt dt))

))

 

Hy vọng bạn hài lòng.

  • 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
beba    0

Hề hề hề,

Bạn dùng thử cái ni xem sao hỉ???

 

Hy vọng bạn hài lòng.

 

Em dùng thử thấy tốt và ưng ý rồi anh ơi,

nhưng em muốn sửa lại thêm 1 cái nữa cho đơn giản là :

Không cần : "\n Nhap chieu cao text: ""\n Kind of area : "

Chỉ cần ra kết quả là được rồi

Anh sửa thêm giúp em. Cảm ơ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  

×