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  
xi_lot

[Nhờ chỉnh sửa] thêm giúp mình text cho lisp tính diện tích

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

xi_lot    0

mình có cái lisp tính diện tích này:

http://www.cadviet.com/upfiles/3/109313_vgtinh_dien_tich.lsp

muốn nhờ các cao thủ thêm tiện ích cho mình như sau:

sau khi đo xong diện tích, lisp cho phép chọn text sẵn có để gán diện tích vào, hiện tại lisp chỉ out ra chữ số thôi.

Mình muốn text được out ra thành: S= ..... m2

Xin các bác giúp đỡ

Cám ơn nhiều!!!!

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
Doan Van Ha    2.676

Đây bạn!

;Chuong trinh tinh tong cac dien tich khi chon mot diem ben trong dien tich kin
;§ang lçi: Neu chon vao mien khong kin thi se gay ra loi
;Gi¶i ph¸p t¹m thêi: NÕu lçi dïng lÖnh "dse"
;§· söa: lçi khuÊt mµn h×nh.
(DEFUN C:Vg ()
(prompt "\n (Lenh tinh nhieu dien tich khong lien nhau)")
(setvar "cmdecho" 0)
 (command "_.UNDO" "_GROUP")
 (SETQ DS (SSADD))
 (setq n 1)
 (if (= sc nil) (setq sc (getreal "\n Nhap ty le ve: ")))
 (setq hs (* sc sc))
 (SETQ A1 0)
 (setq em 0)
(While
 (SETQ G2 (Getpoint "\n Chon mot diem ben trong dien tich can tinh:"))
 (Command "-boundary" G2 "")
 (setq ds3 (ssget "l"))
 (Command "Area" "O" "Last")
 (Command "hatch" "s" "last" "")
 (setq ds4 (ssget "l"))
 (SSADD (SSNAME DS3 0) DS)
 (SSADD (SSNAME DS4 0) DS)
 (setq a2 (Getvar "area"))
 (setq a2 (+ a1 a2))
 (setq t1 (* a2 hs))
 (setq t2 (* t1 0.5))
 (setq em t1)
;  (princ t1)
 (setq a1 a2)
 )
 (command "erase" DS "")
;  (Print "\nTong dien tich can tinh la  s=:")
;  (Princ t1)
 ;(Print "1/2 Tong dien tich can tinh la  S/2=:")
 ;(Princ t2)
(setq s1 (entget (car (entsel "\nChon Text ghi gia tri Dien tich : "))))
(setq otext (assoc 1 s1))
(setq ot (cdr otext))
  (setq ot (read ot))
  (setq nt (cons 1 (strcat "S="(rtos t1 2 2) "m2")))
  (entmod (subst nt otext s1))
(command "luprec" "3")
(setq s1 (ssget))
(command"chprop" "p" "" "c" 6 "")
(command "_.UNDO" "_END")
 (princ)
)
;;;;
(DEFUN C:DSE () (COMMAND "ERASE" DS ""))
;
(defun c:12 ( / ss la rv i tv op en)

  (while (not ss)
     	(princ "\nPick object on the required layers")
     	(setq ss (ssget)))

(initget "Length Area")
  	  (setq rv (getkword "\nWould you like to measure Length/<Area> : "))

  (and (not rv)
   	(setq rv "Area"))

(setq la (cdr (assoc 8 (entget (ssname ss 0))))
    	i (sslength ss)
    	tv 0
    	op 0)
  (while (not (minusp (setq i (1- i))))
     	(setq en (ssname ss i))
     	(command "_.AREA" "_E" en)
     	(cond ((= rv "Length")
            	(setq tv (+ tv (getvar "PERIMETER"))))
	 (T
            	(setq tv (+ tv (getvar "AREA")))
            	(if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
                	(setq op (1+ op))))))

  (princ (strcat "\nTotal " rv "  = " (rtos tv 2 3)
             	" in " (itoa (sslength ss)) " polylines\n"
             	(if (/= rv "Length")
                 	(strcat (itoa op) " with open polylines") "")))
(SETVAR "CMDECHO" 0)
 (princ (strcat "\nGia tri " rv " tinh duoc : " (rtos tv)))
(terpri)
  (setq s1 (entget (car (entsel "Chon Text ghi gia tri : "))))
  (setq otext (assoc 1 s1))
  (setq ot (cdr otext))
  (setq ot (read ot))
  (setq nt (cons 1 (strcat (rtos tv 2 2))))
  (entmod (subst nt otext s1))
(command "luprec" "2")
(setq s1 (ssget))
(command"chprop" "p" "" "c" 6 "")
(prin1))

(defun c:dd1() ; ghi so lieu
(SETVAR "CMDECHO" 0)
(terpri)
 (setq a (getdist "Chieu dai: =? "))
  (princ (strcat "\nGia tri tinh duoc : " (rtos a)))
(setq a (+ a 6))
(terpri)
  (setq s1 (entget (car (entsel "Chon Text ghi gia tri : "))))
  (setq otext (assoc 1 s1))
  (setq ot (cdr otext))
 (setq ot (read ot))
  (setq nt (cons 1 (strcat ( rtos a 2 2))))
  (entmod (subst nt otext s1))
(command "luprec" "2")
(setq s1 (ssget))
(command"chprop" "p" "" "c" 6 "")
(prin1)	   
)
(defun c:tc ( / ss la rv i tv op en)

  (while (not ss)
     	(princ "\nPick object on the required layers")
     	(setq ss (ssget)))

(initget "Length Area")
  	  (setq rv (getkword "\nWould you like to measure Length/<Area> : "))

  (and (not rv)
   	(setq rv "Area"))

(setq la (cdr (assoc 8 (entget (ssname ss 0))))
    	i (sslength ss)
    	tv 0
    	op 0)
  (while (not (minusp (setq i (1- i))))
     	(setq en (ssname ss i))
     	(command "_.AREA" "_E" en)
     	(cond ((= rv "Length")
            	(setq tv (+ tv (getvar "PERIMETER"))))
	 (T
            	(setq tv (+ tv (getvar "AREA")))
            	(if (/= (logand (cdr (assoc 70 (entget en))) 1) 1)
                	(setq op (1+ op))))))

  (princ (strcat "\nTotal " rv "  = " (rtos tv 2 3)
             	" in " (itoa (sslength ss)) " polylines\n"
             	(if (/= rv "Length")
                 	(strcat (itoa op) " with open polylines") "")))
(SETVAR "CMDECHO" 0)
 (princ (strcat "\nGia tri trong co " rv " ta luy tinh duoc : " (rtos tv)))
 (princ (strcat "\nTrong co 2 le dat la 2 m: "))
(setq tv (+ tv 2))
(terpri)
  (setq s1 (entget (car (entsel "Chon Text ghi gia tri : "))))
  (setq otext (assoc 1 s1))
  (setq ot (cdr otext))
  (setq ot (read ot))
  (setq nt (cons 1 (strcat (rtos tv 2 3))))
  (entmod (subst nt otext s1))
(command "luprec" "2")
(setq s1 (ssget))
(command"chprop" "p" "" "c" 6 "")
(prin1))

  • 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  

×