Đến nội dung


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

[Đã xong] Lisp thống kê diện tích Hatch theo Layer


  • Please log in to reply
81 replies to this topic

#41 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 02:20 PM

Yêu cầu đã được chấp thuận ^^. Nếu có Express Tool trong CAD bạn có thể dùng bản này, trau chuốt hơn 1 tí ^^ Cho phép đặt kết quả tại chỗ tùy ý để bạn tiện ghi chú

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
(progn
(vl-load-com)
(acet-sysvar-set (list "cmdecho" 0))
(grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
(Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch : ")
(if (setq ss (ssget(list (cons 0 "HATCH"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
(setq lay (vlax-get-property e 'Layer))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
(setq ar (* 0.000001 (vlax-get-property e 'Area)))
(progn
(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
(redraw (vlax-vla-object->ename e) 3)
)
)
(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))))
txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)
(while (setq e (nth (setq i (1+ i)) lst))
(vla-addtext msp (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") (vlax-3d-point '(0 0 0)) txtsiz)
(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
(command ".move" (entlast) "" '(0 0 0) pt)
)
(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
(alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
(acet-sysvar-restore)(princ))
(defun st-ss->ent (ss / n e l)
(setq n -1)
(while (setq e (ssname ss (setq n (1+ n))))
(setq l (cons e l))
)
)

Bác giúp em làm một cái khi điền text thì không có tên layer ở đằng trước nhé. thanks bác
  • 0

#42 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 2012 - 02:32 PM

Dòng này :
(strcat (car e) " : " (rtos (cdr e) 2 2) "m2")

(car e) = tên layer":" là dấu :Đoạn sau là diện tích + "m2"Bạn thấy k vừa ý chỗ nào thì xóa nó đi :)</pre>
  • 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


#43 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 02:45 PM

Cảm ơn bác nhé, em làm được rồi
  • 0

#44 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 02:51 PM

Dòng này :
(strcat (car e) " : " (rtos (cdr e) 2 2) "m2")

(car e) = tên layer":" là dấu :Đoạn sau là diện tích + "m2"Bạn thấy k vừa ý chỗ nào thì xóa nó đi :)</pre>

cho em hỏi một chút nữa, muốn chỉnh màu và cỡ text thì làm thế nào vậy bác
  • 0

#45 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 2012 - 03:13 PM

Thêm 2 dòng này

(vla-put-color (vlax-ename->vla-object (entlast)) 1 ) ;1 la mau
(vla-put-height (vlax-ename->vla-object (entlast)) 2) ;2 la chieu cao

vào dưới dòng

(command ".move" (entlast) "" '(0 0 0) pt)


  • 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


#46 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 04:22 PM

Thêm 2 dòng này

vào dưới dòng

giúp em với, lúc nãy lisp vẫn hoạt động tốt em không có thay đổi gì cả mà giờ tự nhiên khi điền text thì chẳng thấy text đâu, tải lại cái mới ở trên mạng về cũng vẫn bị vậy, hay là cad của em bị lỗi cái gì nhỉ
  • 0

#47 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 04:54 PM

giúp em với, lúc nãy lisp vẫn hoạt động tốt em không có thay đổi gì cả mà giờ tự nhiên khi điền text thì chẳng thấy text đâu, tải lại cái mới ở trên mạng về cũng vẫn bị vậy, hay là cad của em bị lỗi cái gì nhỉ


hóa ra điểm đặt của text chạy đi rất xa điểm mình chọn, có một lỗi gì đó không biết do đâu
  • 0

#48 Cuongkieu

Cuongkieu

    biết zoom

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

Đã gửi 27 April 2012 - 05:01 PM

hóa ra phải tắt ORTHO đi không thì text chạy lung tung
  • 0

#49 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:07 PM

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

#50 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 02 June 2012 - 01:01 PM

Ý 1 : Bạn đọc bài #42
Ý 2 : mình không hiểu lắm. bạn muốn mỗi lần tạo text lại phải pick xác định chiều cao ? Sao không làm hết 1 lượt rồi dùng các chức năng Match Properties, Ctrl + 1 .....

P/s1 : hatch, không phải hack, cẩn thận k đi tù đấy bạn ơi :)
P/s2 : lisp bạn post là lisp nguyên thủy, trên thực tế đã thay đổi qua nhiều version r, bạn đọc kỹ lại topic nhé :)
  • 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


#51 nhatphong

nhatphong

    biết vẽ circle

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

Đã gửi 04 June 2012 - 08:01 PM

Ý 1 : Bạn đọc bài #42
Ý 2 : mình không hiểu lắm. bạn muốn mỗi lần tạo text lại phải pick xác định chiều cao ? Sao không làm hết 1 lượt rồi dùng các chức năng Match Properties, Ctrl + 1 .....

P/s1 : hatch, không phải hack, cẩn thận k đi tù đấy bạn ơi :)
P/s2 : lisp bạn post là lisp nguyên thủy, trên thực tế đã thay đổi qua nhiều version r, bạn đọc kỹ lại topic nhé :)


Ý 1: Mình không thấy Bạn đọc bài #42 là sao?
Y 2: Tại vì mình sưu tập được 1 lisp tính diện tích và chu vi kiểu như vậy nên mới nhờ bạn giúp :D
Thực ra ý mình là bỏ chữ của layers đầu tiên đi và khi chọn điểm để xuất kết quả là di chuột như scan text (chứ nó xuất mặc định nhiều khi phải scan hoặc zoom lên)
  • 0

#52 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 June 2012 - 12:40 AM

Thục sự là ..

1. Bạn đọc bài #42 tức là bạn kéo đến bài số 42 trong topic này để đọc, vì mình đã trả lời câu đó rồi. Số # nhìn ở phía tay phải mỗi bài viết
2. Đây là lisp tính diện tích hatch theo layer, tức là có thể có nhiều hatch thuộc nhiều layer -> thao tác pick điểm đặt text để xuất ra màn hình có thể phải làm nhiều lần. Bạn muốn mình khi xuất ra thì cho phép bạn pick điểm để định chiều cao cho nó, nên mình hỏi lại : Mỗi lần đặt text lại làm như vậy hay làm 1 lần ngay từ đầu. Câu hỏi vậy rõ chưa bạn ?
  • 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


#53 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 June 2012 - 03:32 PM

File nào của bệnh nào đấy bạn :)
  • 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


#54 dhung7685

dhung7685

    biết zoom

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

Đã gửi 07 June 2012 - 08:19 AM

các bác ơi! sao em dùng tkh để tính mà ko được ! nó cho kết quả bằng 0 hết! e có làm thử trên một cái file khác cũng vậy! các bác xem ntn rồi chỉ giáo giúp e với! tks các bác nhiều!http://www.cadviet.c..._drawing1_1.dwg
  • 0

#55 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 07 June 2012 - 08:49 AM

Bạn xem tỷ lệ bản vẽ của bạn,
Có thể lisp đang xem 1 drawing unit = 1mm, còn file của bạn thì 1 drawing unit = 1 m.
  • 0

#56 hmt

hmt

    biết lệnh scale

  • Members
  • PipPipPip
  • 146 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 10 October 2012 - 12:03 AM

tại sao mình dùng lisp này thì nó cứ cho ra area =0 nhỉ ? mọi ng giải đáp hộ e với
  • 0

#57 viettien_03

viettien_03

    biết vẽ line

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

Đã gửi 22 January 2013 - 10:13 AM

Mình gặp phải 1 vấn đề khi dùng list là diện tích ghi là 0.04 m2, trong khi đó diện tích thực là 37123.42 @@ sao lại vậy nhỉ. Đơn vị bản vẽ của mình để hệ milimeters
  • 0

#58 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 22 January 2013 - 11:32 AM

Mình gặp phải 1 vấn đề khi dùng list là diện tích ghi là 0.04 m2, trong khi đó diện tích thực là 37123.42 @@ sao lại vậy nhỉ. Đơn vị bản vẽ của mình để hệ milimeters

Bạn tìm trong lisp con số 0.000001
và sửa lại là 1
  • 2

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


#59 luiz

luiz

    biết vẽ line

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

Đã gửi 27 March 2013 - 06:33 AM

tại sao mình dùng lisp này thì nó cứ cho ra area =0 nhỉ ? mọi ng giải đáp hộ e với

mình cũng bị giống bác này. diện tích ra = 0 hết mà trong khi hatch đó có area mà. bác nào giải quyết giúp em với em đang cần gấp :(


  • 0

#60 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 27 March 2013 - 07:50 AM


Bạn tìm trong lisp con số 0.000001
và sửa lại là 1


  • 0

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