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

Tháng 6 13, 2011

mình dùng thử đã ổn rồi pro à

chắc có khi cùng lỗi với bạn ở trên

thank you

pro có thể viết thêm cùng loại hatch thì tính 1 diện tích ( về file lớn như quy hoạch có thể dùng rất tốt)

chứ chọn lần lượt từng ô về cơ bản không khác lisp DT là mấy

Rõ ràng mục đích của lisp mình viết là chọn hàng loạt Hatch rồi phân loại theo Loại layer hatch mà, chứ chọn từng cái 1 thì viết lisp chi cho mệt 3d :) Bạn cứ chọn hàng loạt Hatch bằng cái lisp mình viết xem chuyện gì xảy ra :)

Tháng 6 14, 2011

Rõ ràng mục đích của lisp mình viết là chọn hàng loạt Hatch rồi phân loại theo Loại layer hatch mà, chứ chọn từng cái 1 thì viết lisp chi cho mệt 3d :) Bạn cứ chọn hàng loạt Hatch bằng cái lisp mình viết xem chuyện gì xảy ra :)

ok thank pro

nhưng có cách nào pick vào một hach những hach cùng loại sẽ được tính ko

chứ selech hach all kiểu này hơi khó phân biệt các laọi cỏ

nếu như một bản vẽ lớn có các laọi cỏ pick một phát là biết loại cỏ nào bao nhiêu m2 thì tốt biết mấy

mong pro có cách nào prồ hơn không

rất cảm ơn pro

Tháng 6 14, 2011

ok thank pro

nhưng có cách nào pick vào một hach những hach cùng loại sẽ được tính ko

chứ selech hach all kiểu này hơi khó phân biệt các laọi cỏ

nếu như một bản vẽ lớn có các laọi cỏ pick một phát là biết loại cỏ nào bao nhiêu m2 thì tốt biết mấy

mong pro có cách nào prồ hơn không

rất cảm ơn pro

Mình không nhận các chữ pro của bạn được, vì mình không phải thế ^^.Và lisp viết theo yêu cầu của Hoangvu, vì vậy bạn không nên nói như nào là pro hơn, mà đó chỉ là cách bạn cảm thấy tiện hơn cho công việc của bạn thôi.Mà việc đó bạn dùng Qselect cũng được :)

Lisp sửa lại theo yêu cầu của bạn ( cũng vì thế mà đã chọn là tính hết, khỏi chọn vùng luôn )

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt ent)
 (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")  
 (if (setq ent (car (entsel "\nCh\U+1ECDn Hatch \U+0111i\U+1EC3n h\U+00ECnh : ")))
 (progn
  (setq ss (ssget "X" (list (cons 0 "HATCH")(cons 8 (vla-get-layer (vlax-ename->vla-object ent))))))    
     (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)) 
       (wtxt_l (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") '(0 0 0))
(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))
 )
)
(defun wtxt_l(txt p / sty d h1 h2 wf h);;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))

P/S : lisp có 2 biến txtsiz với msp thừa quên chưa xóa, mà để cũng không sao ^^

Tháng 6 14, 2011

Mình không nhận các chữ pro của bạn được, vì mình không phải thế ^^.Và lisp viết theo yêu cầu của Hoangvu, vì vậy bạn không nên nói như nào là pro hơn, mà đó chỉ là cách bạn cảm thấy tiện hơn cho công việc của bạn thôi.Mà việc đó bạn dùng Qselect cũng được :)

Lisp sửa lại theo yêu cầu của bạn ( cũng vì thế mà đã chọn là tính hết, khỏi chọn vùng luôn )

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt ent)
 (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")  
 (if (setq ent (car (entsel "\nCh\U+1ECDn Hatch \U+0111i\U+1EC3n h\U+00ECnh : ")))
 (progn
  (setq ss (ssget "X" (list (cons 0 "HATCH")(cons 8 (vla-get-layer (vlax-ename->vla-object ent))))))    
     (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)) 
       (wtxt_l (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") '(0 0 0))
(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))
 )
)
(defun wtxt_l(txt p / sty d h1 h2 wf h);;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))

Cảm ơn bạn đã nhiệt tình giúp đỡ anh em tụi mình. Tuy nhiên yêu cầu của bạn 3d có lẽ hơi dư, vì các lý do sau:

- bản vẽ cảnh quan các lớp hacth đan xen nhau (như giữa thảm cỏ có vài mảng hoa...), đồng thời một số lớp cực lớn, do đó nếu chạy một lần ra hết có thể rất là nặng, máy yếu hay hatch bị lỗi sẽ rất lâu hoặc treo máy.

- Ứng dụng quan trọng nhất mà mình yêu cầu ở lisp này ko phải chỉ để tính DT mà quan trọng nhất là ra text chú thích vật liệu cho đối tượng bản vẽ nhanh hơn mà lẽ ra mình phải lọ mọ điền thủ công như trước đây rất mất thời gian.

- Dùng lisp này bạn phải chú ý kiểm properties từng mảng hatch ngay khi hatch xong xem có thông số DT ko, vì nếu nó bị lỗi thì sẽ thiếu DT (do đó đề nghị Ketxu bổ sung thông báo lỗi nếu có 1 mảng nào đó bị lỗi, hoặc nếu thêm chức năng highlight mảng đó ln thì càng tốt).

- Nếu chỉ cần tính tổng diện tích 1 loại hatch, bạn chỉ cần set các mảng hatch cùng loại chung 1 layer, sau đó dùng lệnh layiso để chỉ hiển thị mỗi lớp đó, rồi chọn tất cả, chọn xem properties là xong. Nếu có lớp nào đó lỗi thì sẽ ko ra DT, co đó ko sợ mất DT. Lưu ý là hình như phải từ cad 2004 trở lên thì phải.

Cuối cùng xin cảm ơn sự giúp đỡ nhiệt tình của các bạn, cảm ơn rất nhiều.

Tháng 6 14, 2011

Cảm ơn bạn đã nhiệt tình giúp đỡ anh em tụi mình. Tuy nhiên yêu cầu của bạn 3d có lẽ hơi dư, vì các lý do sau:

- bản vẽ cảnh quan các lớp hacth đan xen nhau (như giữa thảm cỏ có vài mảng hoa...), đồng thời một số lớp cực lớn, do đó nếu chạy một lần ra hết có thể rất là nặng, máy yếu hay hatch bị lỗi sẽ rất lâu hoặc treo máy.

- Ứng dụng quan trọng nhất mà mình yêu cầu ở lisp này ko phải chỉ để tính DT mà quan trọng nhất là ra text chú thích vật liệu cho đối tượng bản vẽ nhanh hơn mà lẽ ra mình phải lọ mọ điền thủ công như trước đây rất mất thời gian.

- Dùng lisp này bạn phải chú ý kiểm properties từng mảng hatch ngay khi hatch xong xem có thông số DT ko, vì nếu nó bị lỗi thì sẽ thiếu DT (do đó đề nghị Ketxu bổ sung thông báo lỗi nếu có 1 mảng nào đó bị lỗi, hoặc nếu thêm chức năng highlight mảng đó ln thì càng tốt).

- Nếu chỉ cần tính tổng diện tích 1 loại hatch, bạn chỉ cần set các mảng hatch cùng loại chung 1 layer, sau đó dùng lệnh layiso để chỉ hiển thị mỗi lớp đó, rồi chọn tất cả, chọn xem properties là xong. Nếu có lớp nào đó lỗi thì sẽ ko ra DT, co đó ko sợ mất DT. Lưu ý là hình như phải từ cad 2004 trở lên thì phải.

Cuối cùng xin cảm ơn sự giúp đỡ nhiệt tình của các bạn, cảm ơn rất nhiều.

- Mỗi người có 1 quan điểm, nên mình đã sửa theo yêu cầu của 3d, còn bạn, thấy thích hợp với lisp nào, bạn cứ dùng lisp đó, đâu có cần lấy cái mình viết cho 3d về ^^

- Đỏ : đã có trong mấy bản trước mình viết, có cả phần kiểm tra phiên bản CAD, cả thông báo nếu Hatch không tính được diện tích, và cho nó bằng 0, cả Highlight vùng Hatch đó, mình đã nhắc bạn nhưng chắc bạn chưa để ý ?

- Xanh : Dùng qselect -> Ctrl 1

Tháng 6 14, 2011

- Mỗi người có 1 quan điểm, nên mình đã sửa theo yêu cầu của 3d, còn bạn, thấy thích hợp với lisp nào, bạn cứ dùng lisp đó, đâu có cần lấy cái mình viết cho 3d về ^^

- Đỏ : đã có trong mấy bản trước mình viết, có cả phần kiểm tra phiên bản CAD, cả thông báo nếu Hatch không tính được diện tích, và cho nó bằng 0, cả Highlight vùng Hatch đó, mình đã nhắc bạn nhưng chắc bạn chưa để ý ?

- Xanh : Dùng qselect -> Ctrl 1

thank you pro

cái đó gọi là được voi đòi hai bà trưng đó mà

mình dùng tất các lisp của pro

pro oi hình như cái lisp này tính tổng tất cả các hack chứ không phải tính riêng từng loại hach

pro thử xem thế nào

Tháng 6 14, 2011

thank you pro

cái đó gọi là được voi đòi hai bà trưng đó mà

mình dùng tất các lisp của pro

pro oi hình như cái lisp này tính tổng tất cả các hack chứ không phải tính riêng từng loại hach

pro thử xem thế nào

Lisp tính tổng tất cả các Hatch chung 1 layer theo ý bạn bài trước! Còn bạn có yêu cầu khác thì nói ngay từ đầu, chứ sửa theo Rl của bạn mình bị tẩu hỏa mất :)

Tháng 6 15, 2011

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))
 )
)

Lại làm phiền các bạn nữa rồi. Lisp xài rất ổn tuy nhiên khi sử dụng lại nảy sinh một vấn đề nho nhỏ. Đó là ra text Diện tích rồi thì khi mình Move vào gắn trên các Leader (chỉ vào mảng Hatch) thì rất khó để canh chỉnh cho đều được, nên rất lâu.

Mình hy vọng lisp này có thể sửa thêm thành 1 bản có tính năng chọn vào text có sẵn khi ra diện tích (giống như cái lisp udt.lisp vậy). Khi đó mình có thể click vào các text có sẵn của Qleader thì sẽ rất sễ dàng chỉnh sửa, định dạng.

Mong các bạn giúp đỡ mình hén. Xin Cảm ơn trước!

Tháng 6 15, 2011

Lại làm phiền các bạn nữa rồi. Lisp xài rất ổn tuy nhiên khi sử dụng lại nảy sinh một vấn đề nho nhỏ. Đó là ra text Diện tích rồi thì khi mình Move vào gắn trên các Leader (chỉ vào mảng Hatch) thì rất khó để canh chỉnh cho đều được, nên rất lâu.

Mình hy vọng lisp này có thể sửa thêm thành 1 bản có tính năng chọn vào text có sẵn khi ra diện tích (giống như cái lisp udt.lisp vậy). Khi đó mình có thể click vào các text có sẵn của Qleader thì sẽ rất sễ dàng chỉnh sửa, định dạng.

Mong các bạn giúp đỡ mình hén. Xin Cảm ơn trước!

Mình có thể giúp bạn vẽ luôn Qleader + ghi chú trong quá trình tính diện tích Hatch. OK ?

Tháng 6 15, 2011

Mình có thể giúp bạn vẽ luôn Qleader + ghi chú trong quá trình tính diện tích Hatch. OK ?

pro ơi có tính được từng loại hatch ko

có pro nào rối viết cho mình lisp WELD được không

selech một số line

hởi kích thước vd:200

tất cả các điểm line hở không chạm line nào ( khảng cách cách nhau dưới 200 )

sẽ được nói với nhau bằng đường line cùng layẻr ( hoặc layer hiện thời )

rất cảm ơn ạ

Tháng 6 16, 2011

Mình có thể giúp bạn vẽ luôn Qleader + ghi chú trong quá trình tính diện tích Hatch. OK ?

[/quotz

Mình nghĩ chỉ nên bổ sung tính năng chọn text ra kết quả thôi vì như vậy có thể sử dụng trong trường hợp không cần leader. Mong bạn giúp đỡ! Thanks

Tháng 6 16, 2011

Mình có thể giúp bạn vẽ luôn Qleader + ghi chú trong quá trình tính diện tích Hatch. OK ?

Mình nghĩ chỉ nên bổ sung tính năng chọn text ra kết quả thôi vì như vậy có thể sử dụng trong trường hợp không cần leader. Mong bạn giúp đỡ! Thanks

Bạn thử xem.

(defun c:tkh1 (/ 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))		
       (while  (not(wcmatch(cdadr 
			(entget (setq ent (car(entsel (strcat "\n\U+0110i\U+1EC3m Text ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))))) "*TEXT"))
			(setq ent (car(entsel (strcat "\n\U+0110i\U+1EC3m Text ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e)))))
	)
	(vla-put-textstring (vlax-ename->vla-object ent) (strcat (car e) " : " (rtos (cdr e) 2 2) "m2"))
	)
		(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))

Tháng 6 16, 2011

Bạn thử xem.

(defun c:tkh1 (/ 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))		
       (while  (not(wcmatch(cdadr 
			(entget (setq ent (car(entsel (strcat "\n\U+0110i\U+1EC3m Text ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))))) "*TEXT"))
			(setq ent (car(entsel (strcat "\n\U+0110i\U+1EC3m Text ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e)))))
	)
	(vla-put-textstring (vlax-ename->vla-object ent) (strcat (car e) " : " (rtos (cdr e) 2 2) "m2"))
	)
		(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))

Bạn ơi, sao nó chỉ bảo chọn Hatch cần tính rồi im ln, ko ra tiếp yêu cầu chọn text nữa vậy bạn? Nhờ bạn kiểm tra giùm. Thanks

Tháng 6 16, 2011

Bạn ơi, sao nó chỉ bảo chọn Hatch cần tính rồi im ln, ko ra tiếp yêu cầu chọn text nữa vậy bạn? Nhờ bạn kiểm tra giùm. Thanks

Im là im kiểu gì bạn??? Đề nghị bạn mỗi lần chạy lisp, nếu thấy lỗi thì ấn F2 để xem nó thông báo cái gì rồi post lên giùm người viết lisp, chứ bạn nói nó im luôn thì mình cũng ngọng luôn :) . À chú ý hàm st-ss->ent bạn copy từ lisp cũ sang, vì mình đã viết ở lisp cũ rồi nên k cop lại sang lisp này nữa. Thân!

Tháng 6 16, 2011

Im là im kiểu gì bạn??? Đề nghị bạn mỗi lần chạy lisp, nếu thấy lỗi thì ấn F2 để xem nó thông báo cái gì rồi post lên giùm người viết lisp, chứ bạn nói nó im luôn thì mình cũng ngọng luôn :) . À chú ý hàm st-ss->ent bạn copy từ lisp cũ sang, vì mình đã viết ở lisp cũ rồi nên k cop lại sang lisp này nữa. Thân!

Mình đã copy cái hàm đó vô rồi, chạy ok. Cảm ơn bạn. Tại mình ko biết gì về cấu trúc hàm nên đôi khi hỏi xà quần làm phiền các bạn. Mong được thông cảm. Thanks

Tháng 4 27, 2012

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

Tháng 4 27, 2012

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>

Tháng 4 27, 2012

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

Tháng 4 27, 2012

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

Tháng 4 27, 2012

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)

Tháng 4 27, 2012

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ỉ

Tháng 4 27, 2012

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

Tháng 4 27, 2012

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

Tháng 6 2, 2012

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))

7e92b02502acb4434c18293e14f7fa46_45585704.12.jpg

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

Tháng 6 2, 2012

Ý 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é :)

Đăng nhập

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

Các bài được khuyến nghị

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

3d.decor 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Hoangvulandscape 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

3d.decor 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Hoangvulandscape 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

3d.decor 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Hoangvulandscape 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Hoangvulandscape 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Hoangvulandscape 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Cuongkieu 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Cuongkieu 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Cuongkieu 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2997