Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 xi_lot

xi_lot

    Chưa sử dụng CAD

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

Đã gửi 25 May 2012 - 12:00 PM

mình có cái lisp tính diện tích này:
http://www.cadviet.c...h_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!!!!
  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 25 May 2012 - 12:19 PM

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

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


#3 xi_lot

xi_lot

    Chưa sử dụng CAD

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

Đã gửi 25 May 2012 - 12:37 PM

Em cám ơn bác nhiều nhé!!!! Thanks!!!!
  • 0