Đến nội dung


Hình ảnh
- - - - -

[Nhờ Sửa Lisp]tính diện tích vù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 02 June 2012 - 11:06 AM

http://www.cadviet.c.../152139_tkh.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...c=13203&st=3680
(defun c:tkh (/ lst msp pt ss lay ar txtsiz)
(vl-load-com)
(if (setq ss (ssget(list (cons 0 "HATCH"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lay (vla-get-layer e) ar (vla-get-area e))
(if (not (assoc lay lst))
(setq lst (cons (cons lay ar) lst))
(setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
(assoc lay lst) lst))) )
(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
tl 0.000001
pt (getpoint "\nDiem dat Bang :" )
txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(foreach e lst
(vla-addtext msp (car e) (vlax-3d-point pt) txtsiz )
(vla-addtext msp
(strcat (rtos (* (cdr e) tl) 2 2) " m2") (vlax-3d-point (polar pt 0 (* 10 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz))) ) )
(alert "Khong chon duoc Hatch.") )
(princ))


Hình đã gửi
lisp này của bạn KETXU

mình muốn bỏ layers trước kết quả tính và text xuất kết quả là tăng theo scan khi mình chọn và di chuột chứ không phải ra text mặc định..thank các bạn trước
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 02 June 2012 - 11:28 AM

Link bài này của bạn đâu ? bạn search Google từ C:tkh ketxu cadviet và post yêu cầu ở topic đó nhé
  • 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


#3 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 02 June 2012 - 12:08 PM

Link bài này của bạn đâu ? bạn search Google từ C:tkh ketxu cadviet và post yêu cầu ở topic đó nhé

mình chuyển sang bài theo link http://www.cadviet.c...pic=47301&st=40

bạn xóa giúp mình topic này nhé :)
  • 0