Đến nội dung


Hình ảnh
- - - - -

[Nhờ sửa]Lisp tính tổng hatch


  • Please log in to reply
2 replies to this topic

#1 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 27 April 2014 - 03:42 AM

t(defun c:dtth(/ cnt tot ss obj )
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
(progn
(vl-load-com)
(setq cnt 0 tot 0 )
(princ "\nCh\U+1ECDn c\U+00E1c v\U+00F9ng hatch c\U+1EA7n t\U+00EDnh t\U+1ED5ng")
(if (setq ss (ssget '((0 . "HATCH"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex 

ss))))
(if (vlax-property-available-p e 'Area)
(setq cnt (1+ cnt)
tot (+ tot (vla-get-Area e))
)
)
)
(princ (strcat "\nT\U+1ED5ng di\U+1EC7n t\U+00EDch "(itoa cnt) " Hatch l\U+00E0: " 

(rtos tot) ) )
(setq obj (entsel "\nCh\U+1ECDn text \U+0111\U+1EC3 ghi k\U+1EBFt qu\U+1EA3 hoac k\U

+1EBFt th\U+00FAc \U+0111\U+1EC3 xem gi\U+00E1 tr\U+1ECB"))
(if (and
obj
(setq obj (vlax-ename->vla-object (car obj)))
(eq (vlax-get obj 'ObjectName) "AcDbText")
)
(vla-put-TextString obj (rtos tot))
)
(princ)
)
(princ "\nKB\U+1EA1n ch\U+01B0a ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng hatch n\U

+00E0o c\U+1EA3" )
)
)
(alert "\nPhi\U+00EAn b\U+1EA3n autocad c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U

+1EE3!")
)
) 

Mình tìm trên mạng được lisp này,cũng khá hay các bác có thể cho e thêm cái đơn vị tính ra "M2" ở cuối được không ạ... :unsure:

 

Không hiểu sao khi kết hợp với cái lisp này của bác Ketxu sao giá trị tổng lại kg bằng nhỉ : :D

http://www.cadviet.c...eo-layer/page-3

 

Nhờ các cao thủ ra tay dùm  :ph34r:


  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 April 2014 - 10:32 AM

Sửa dòng (rtos tot) thành (strcat (rtos tot) " m2") bạn nhé. Còn cái bạn thắc mắc bên topic kia - k có file mình ngại xem lắm


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 April 2014 - 02:14 PM

Bạn sửa chữ (rtos tot) thành (rtos (/ tot 1000000) 2 2)


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC