Đến nội dung


Hình ảnh
- - - - -

[ nhờ chỉnh sửa] lisp Đo diện tích(a)


  • Please log in to reply
3 replies to this topic

#1 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 18 June 2012 - 05:53 PM

Mình có cái lisp này,
1.không hiêu tại sao load lệnh xong,đo được một vài mắt cắt thì TRUY BẮT ĐIỂM bị tắt hết
2. Muôn cái lisp này chon màu do mình tự chọn khi xuất ra text co săn.
Mình dung 3g nên up phai len chận nên xin mạo muội copy pate vao vậy.
mong cả nhà giúp

(defun c:A()
(princ "\nCHAO cadviet")
(if (= Ty_le nil)
(progn
(initget (+ 1 2 4))
(print)
(print)
(setq Ty_le (getreal "\nXin a nhap ty le! : "))
)
)
(setq ntl (/ 1 Ty_le))
(setq tl2 (* ntl ntl))
(print)

(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nem xin anh chon vung: "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(command "hatch" "ANSI31" 4 "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\n xin a chon diem: "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tl2))
;;(setq dtl (/ dtl 2.0))
(setq en (car (entsel "Thay cho so : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
(entmod elst)
(command "change" en "" "p" "layer" 6 "" "")
; (print)
; (prompt (strcat "\nTotal area : " (rtos dtl 2 2)))
; (print)
; (setq pt2 (getpoint "\n Viet ra !: "))
; (command "text" pt2 "0" "2" (rtos dtl 4 2))
);defun

  • 0

#2 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 18 June 2012 - 07:38 PM

Bạn thêm 2 dòng vào như mình đã đánh dấu

(defun c:A()
(princ "\nCHAO cadviet")
(if (= Ty_le nil)
(progn
(initget (+ 1 2 4))
(print)
(print)
(setq Ty_le (getreal "\nXin a nhap ty le! : "))
)
)
(setq ntl (/ 1 Ty_le))
(setq tl2 (* ntl ntl))
(print)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nem xin anh chon vung: "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(command "hatch" "ANSI31" 4 "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\n xin a chon diem: "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tl2))
;;(setq dtl (/ dtl 2.0))
(setq en (car (entsel "Thay cho so : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
(entmod elst)
(setq mau (getint "\nXin anh chon mau: "));; Dong viet them
(command "change" en "" "p" "COLOR" mau "" "") ;; Sua lai dong nay
; (print)
; (prompt (strcat "\nTotal area : " (rtos dtl 2 2)))
; (print)
; (setq pt2 (getpoint "\n Viet ra !: "))
; (command "text" pt2 "0" "2" (rtos dtl 4 2))
(setvar "OSMODE" oslast) ;; Dong viet them
);defun

  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#3 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 19 June 2012 - 06:52 PM

CÁM ƠN BẠN NHA!
  • 0

#4 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 19 June 2012 - 09:05 PM

Bạn có thể giúp :
1.chỉ 1 lần chọn màu thôi,lisp này mỗi lần tính điện tích lại mất công chon mầu
2.truy bắt điểm vẫn lỗi bạn à
  • 0