Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
huaductiep

Nhờ hướng dẫn sửa lisp diện tích?

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

;; free lisp from cadviet.com

Mình download trên cadviet được lisp tính diện tích như với lệnh dt2 như link gửi ở bên dưới. Mình loay hoay tìm cách sửa sao cho nó chỉ hỏi nhập tỉ lệ bản vẽ và số chữ số thập phân 1 lần đầu duy nhất thôi. Từ lần sau pick lại thì nó tự nhớ tỉ lệ và số chữ thập phân trước đó, ko hỏi nữa.. mà mình chưa tìm ra cách. Mong mọi người chỉ giúp mình với. 
Xin chân thành cám ơn mọi người đã đọc bài viết :)

http://www.cadviet.com/upfiles/3/64997_lap_bang_tinh_dien_tich_dt2_ok.lsp

 

;------------------------------------tinh dien tich (dt2)-----------------------------------
(Defun c:dt2()
(setvar "cmdecho" 0)
(initget "Heso Do")
        (if (not tpo) (setq tpo 1))
        (setq SC (getint (strcat "\n Nhap ti le <" (itoa tpo) "> :")))
        (if (not SC) (setq SC tpo) (setq tpo SC))
        (if (not tp1) (setq tp1 2))
        (setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tp1) "> :")))
        (if (not tp) (setq tp tp1) (setq tp1 tp))
(setq pt (getpoint "\n chon diem:"))
    (if (= pt "Heso")
    (progn
(setq am (getreal "\n loccoc259.co.cc : "))
(if (and (null am) (/= ac 0))
(setq am ac)
)
(setq pt (getpoint "\n Chon diem: "))
)
(setq ac am))
 
(if (or (= am 0) (null am)) (setq am 1))
(setq s 0)
(progn 
; (setq pt (getpoint "\n Chon diem: "))
     (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 Chon diem: "))
(entdel (entlast))
        )
(progn
(princ "chon diem sai")
(setq pt (getpoint "\n Chon diem: "))
)
)
 )
 
            )
 
(setq dt1 (* s am SC SC))
(setq dt (/ dt1 10))
(princ dt)
(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
)
(vla-put-TextString obj (rtos dt 2 tp))
)
 

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

Cám ơn bác. Nhưng em sử dụng thì bị báo lỗi sau:

 

Command: dt2

Nhap So chu so thap phan <2>:

chon diem:

Chon diem: 1.06159e+006

Chon text de ghi ket qua:; error: bad argument type: fixnump: nil

 
 Nhap So chu so thap phan <2>:
 
 chon diem:
 Chon diem:
1.06159e+006
Chon text de ghi ket qua:; error: bad argument type: fixnump: nil
 
 
 Nhap So chu so thap phan <2>:
 
 chon diem:
 Chon diem:
1.06159e+006
Chon text de ghi ket qua:; error: bad argument type: fixnump: nil
 
 
Command: dt2
 
 Nhap So chu so thap phan <2>:
 
 chon diem:
 Chon diem:
1.06159e+006

 

Chon text de ghi ket qua:; error: bad argument type: fixnump: nil
 
Command: dt2
 
 Nhap So chu so thap phan <2>:
 
 chon diem:
 Chon diem:
1.06159e+006

 

Chon text de ghi ket qua:; error: bad argument type: fixnump: nil
 
Command: dt2
 
 Nhap So chu so thap phan <2>:
 
 chon diem:
 Chon diem:
1.06159e+006
Chon text de ghi ket qua:; error: bad argument type: fixnump: nil

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

hj..được rồi. cám ơn bác nhiều lắm.
Tiện đây cho em hỏi luôn. Diễn đàn mình có topic nào làm Lisp theo yêu cầu (có phí) ko nhỉ? Vì mình thấy cái này rất thiết thực, chắc chắn sẽ nhiều người ko tiếc gì đâu và sẽ rất ủng hộ việc này.

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  

×