Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 beba

beba

    biết zoom

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

Đã gửi 11 June 2011 - 08:48 AM

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

))


  • 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 11 June 2011 - 11:08 PM

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

beba

    biết zoom

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

Đã gửi 13 June 2011 - 09:28 AM

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