Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa]lisp tính tổng diện tích của bác Nguyen Hoanh


  • Please log in to reply
2 replies to this topic

#1 nhimret

nhimret

    biết zoom

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

Đã gửi 07 September 2013 - 04:12 PM

(defun c:udt (/ ss tong ham tmp tt)
  (setq
    ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))	
    tong 0.0
    ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
    tmp (mapcar 'ham (ss2ent ss))  
    hstl 0.001
    tp 2
    tt (entget (car (entsel "\nChon text ket qua: ")))
    tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
  )
  (entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
  (setq 
    sodt (if ss (sslength ss) 0)	 
    index 0
  )
  (repeat sodt
    (setq ent (ssname ss index)
	  index (1+ index)
	  lstent (cons ent lstent)
    )
  )
  (reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com) 

 

Lisp này tui đã dùng được hơn 4 năm rồi, không có gì phàn nàn về hiệu quả của nó, nhưng bây giờ muốn nhờ các bác chỉnh sửa 1 tí để phù hợp hơn với nhu cầu hiện giờ ah

 

Hiện giờ: mỗi khi ra kết quả, lisp chỉ hiển thị số diện tích. VD: 10,1

 

Yêu cầu: Hiển thị kết quả, sẽ hiển thị S=10,1 m2

 

Cám ơn các bác trước :)


  • 0

#2 Namvanvo

Namvanvo

    Edu level: li5

  • Members
  • PipPipPipPipPip
  • 386 Bài viết
Điểm đánh giá: 42 (tàm tạm)

Đã gửi 07 September 2013 - 10:38 PM


(defun c:udt (/ ss tong ham tmp tt)
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss))
hstl 0.001
tp 2
tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

Sửa:

 

(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

Thành:

(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))


  • 2

#3 nhimret

nhimret

    biết zoom

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

Đã gửi 11 September 2013 - 10:11 AM


(defun c:udt (/ ss tong ham tmp tt)
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>")))
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss))
hstl 0.001
tp 2
tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

Sửa:

 

(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

Thành:

(entmod (subst (cons 1 (strcat "S = " (rtos (* (atof tong) hstl hstl) 2 tp) "M2")) (assoc 1 tt) tt))

 

cám ơn bác nhiều nhiều, mấy hôm đi công tác hôm nay mới vào cadviet được :-*


  • 0