Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 nestxanh

nestxanh

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 04 November 2011 - 02:09 PM

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

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 November 2011 - 02:13 PM

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è????
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 nestxanh

nestxanh

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 04 November 2011 - 02:24 PM

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 ạ!
  • 0

#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 November 2011 - 03:06 PM

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
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 nestxanh

nestxanh

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 04 November 2011 - 03:18 PM

Thanks bác phamthanhbinh, quá đúng theo móng muốn rồi ah! :D
  • 0

#6 hoangkimoanh

hoangkimoanh

    biết vẽ spline

  • Members
  • PipPip
  • 92 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 22 August 2013 - 12:23 AM

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 : "))


  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 22 August 2013 - 06:42 AM

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)


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 hoangkimoanh

hoangkimoanh

    biết vẽ spline

  • Members
  • PipPip
  • 92 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 23 August 2013 - 09:42 AM

cảm ơn anh ha rất nhiều


  • 0

#9 ngochung410

ngochung410

    Chưa sử dụng CAD

  • Members
  • Pip
  • 4 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 April 2014 - 10:06 AM

Nhờ các bác giúp. Em muốn tăng độ chính xác lên 3 hay 4 số sau dấu phẩy thì em nên sửa câu nào ạ.


  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 06 April 2014 - 10:30 AM

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))


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.