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  
nestxanh

Nhờ mọi người sửa hộ lisp đo diện tích

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

Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code của mình thì cho gửi lời cám ơn nhé. Mình muốn nhờ thêm mọi người sửa hộ code để sau khi điền giá trị diện tích vào text thì mầu text được thay đổi để dễ nhận biết, mầu nào cũng đc miễn là khác mầu cũ của text.

 

Code file lisp mà mình có:

(defun c:N()
 (if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
(setq ntl (/ 100 tl))
(setq tl2 (* ntl ntl))
)
 )
 (setq dtl 0)
 (setq ss (ssadd))
 (setq oslast (getvar "OSMODE"))
 (command "osnap" "")
 (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") 3 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
 )
 (command "setvar" "OSMODE" oslast)
 (command "erase" ss "")
 (setq ss nil)
 (command "redraw")
 (setq dtl (/ dtl tl2))
 (print dtl)
 (setq elst (entget (car (entsel "Thay cho so: "))))
 (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
 (entmod elst)
 (print)
 (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
 (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun

 

Xin chân thành 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

Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code của mình thì cho gửi lời cám ơn nhé. Mình muốn nhờ thêm mọi người sửa hộ code để sau khi điền giá trị diện tích vào text thì mầu text được thay đổi để dễ nhận biết, mầu nào cũng đc miễn là khác mầu cũ của text.

 

Code file lisp mà mình có:

(defun c:N()
 (if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
(setq ntl (/ 100 tl))
(setq tl2 (* ntl ntl))
)
 )
 (setq dtl 0)
 (setq ss (ssadd))
 (setq oslast (getvar "OSMODE"))
 (command "osnap" "")
 (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") 3 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
 )
 (command "setvar" "OSMODE" oslast)
 (command "erase" ss "")
 (setq ss nil)
 (command "redraw")
 (setq dtl (/ dtl tl2))
 (print dtl)
 (setq elst (entget (car (entsel "Thay cho so: "))))
 (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
 (entmod elst)
 (print)
 (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
 (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun

 

Xin chân thành cảm ơn!

Hề hề hề,

Vậy chứ cái màu text cũ là màu chi để còn biết đường mà tránh chứ hè????

  • 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

Vâng, text cũ của em thường là mầu vàng (mầu diện tích của chú nova :D), bác cho em về mầu 140 càng tốt ạ!

Hề hề hề.

Ok có ngay đây.

Bạn bổ sung các dòng code sau đây:

(if (= (assoc 62 elst) nil)

(setq elst (cons (cons 62 140) elst))

(setq elst (subst (cons 62 140) (assoc 62 elst) elst))

)

vào bên dưới dòng code

(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))

và trên dòng code

(entmod elst)

 

Hy vọng đúng ý bạn

  • 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ờ các anh sửa đoạn này để mặc định là 1 và không cần hỏi cái này nữa với!

 

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

(setq tl 1.0)

  • 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

Sửa:

(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))

Thành:

(setq elst (subst (cons 1 (rtos dtl 2 4)) (assoc 1 elst) elst))

  • 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

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  

×