Đến nội dung


Hình ảnh
* * * * - 1 Bình chọn

[Yêu Cầu] Lisp Tính Diện Tích Text, Số


  • Please log in to reply
5 replies to this topic

#1 danhgapro

danhgapro

    biết vẽ circle

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

Đã gửi 12 July 2016 - 05:00 PM

:)  Chào các bạn.

Mình đang có công việc cần tính diện tích sơn, in chữ. Nên mình nhờ các bạn chỉ giúp, hoặc viết dùm mình 1 cái lisp tính diện tích của chữ cái và số theo font chữ, kích thước chữ cần in. Cảm ơn nhiều.


  • 0

#2 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 13 July 2016 - 07:50 AM

Cái lisp này viết lâu rồi, chắc vẫn còn xài được. Cad phải có cài Express.

(defun c:dtc (/ v0 el en l tong oe nd)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

  • 0

#3 danhgapro

danhgapro

    biết vẽ circle

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

Đã gửi 25 July 2016 - 03:35 PM

 

Cái lisp này viết lâu rồi, chắc vẫn còn xài được. Cad phải có cài Express.

(defun c:dtc (/ v0 el en l tong oe nd)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

Bạn kiểm tra lại giúp mình, mình dùng lisp tính thử với bo nét chữ không đúng. (đã cài Express).

Bài toán là: mình cần tính diện tích sơn, in chữ biển báo, VD "ĐI CHẬM", mình tính diện tích chữ Đ, I, C.....

Cảm ơn bạn. 


  • 0

#4 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 25 July 2016 - 04:14 PM

Bạn đưa file ví dụ của bạn lên xem và cho biết diện tích đúng của từng chữ là bao nhiêu.


  • 0

#5 danhgapro

danhgapro

    biết vẽ circle

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

Đã gửi 25 July 2016 - 04:53 PM

Bạn đưa file ví dụ của bạn lên xem và cho biết diện tích đúng của từng chữ là bao nhiêu.

http://www.cadviet.c...s/6/86607_1.dwg

 

Mình ví dụ các chữ bo đơn giản. Cảm ơn bạn.


  • 0

#6 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 25 July 2016 - 08:08 PM

Do trong file của bạn để units là meters khác với unitless nên giá trị bị sai, bạn chép lại lsp.

Bạn copy những dòng dưới đây chứ đừng download.

(defun c:dtc (/ v0 el en l tong oe nd un)
  (setq oe (getvar 'cmdecho)
un (getvar 'insunits))
  (setvar 'cmdecho 0)
  (setvar 'insunits 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
 nd (cdr (assoc 1 (entget v0))))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
 l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (cdr (assoc 0 (entget x))))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
(setvar 'insunits un)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)

  • 0