Đế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

#21 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 11 June 2011 - 10:27 AM

Mình biết rồi. Lỗi này là do miếng Hatch của bạn bị lỗi ko có giá trị diện tích (bạn coi trong mục Properties ấy). Nếu trong Properties mà ko có diện tích thì sẽ bị lỗi trên



có Area mà vậy khắc phục thế nào pro nhỉ
mình trót dùng cad 2012 mất rồi
thôi dùng tạm lisp DT vậy

Trong lisp up sau khi gặp Hatch bị lỗi thì chương trình sẽ Highlight và thông báo nó không tính được, chứ không còn thông báo lỗi giống lisp lúc đầu như bạn 3d.decor nói (bạn Hoangvu có thể kiểm tra phần Hatch thuộc layer hatch trong bản vẽ của bạn để thấy ), nên mình bó tay vì không biết CAD12 của bạn nó ương ở chỗ nào :)
  • 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


#22 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 11 June 2011 - 10:44 PM

Cảm ơn bạn, đây thực sự là cái mình cần. Cảm ơn rất nhiều


Nhờ bạn kiểm tra lại xem, sao đôi lúc tính đúng, nhưng đôi lúc tính ko đúng (hình như diện tích bị giảm gần 1 nửa. Với lại chỉ cần 2 con số lẻ thôi và cho cỡ chữ lớn lên khoảng 10 lần dc ko

Hề hề hề,
Lisp nó hổng tính sai đâu. Có nhẽ việc nó cho kết quả sai là do trong vùng hatch của bạn có lẫn một vài đường chia cắt vùng nào đó mà bạn không chú ý đấy thôi.
Khi chạy lisp, bạn chú ý một chút sẽ thấy cái boundary nó xuất hiện một chút rồi mất. Hãy so sánh cái boundary này với vùng hatch của bạn để phát hiện ra đường chia cắt đó.
Việc bạn muốn text lớn gấp 10 lần và chỉ lấy hai chữ số lẻ rất đơn giản. Hãy thay dòng code (command "text" p1 2 0 (strcat ten ": " (rtos dtch 2 6) " M2")) thành (command "text" p1 20 0 (strcat ten ": " (rtos dtch 2 2) " M2")).
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#23 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 12 June 2011 - 11:49 AM

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


Chào bạn, lại làm phiền bạn nữa rồi. Không hiểu sao có một số file cad ko sử dụng dc lisp này: nó chỉ load tới lệnh bảo chọn Hatch rồi im luôn không chạy nữa. Mình gởi kèm file cho bạn kiểm giùm. Cảm ơn bạn!
link bản vẽ: http://www.mediafire...j2xlcl9tzev6jma
Cảm ơn!
  • 0

#24 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 June 2011 - 12:48 PM

Chào bạn, lại làm phiền bạn nữa rồi. Không hiểu sao có một số file cad ko sử dụng dc lisp này: nó chỉ load tới lệnh bảo chọn Hatch rồi im luôn không chạy nữa. Mình gởi kèm file cho bạn kiểm giùm. Cảm ơn bạn!
link bản vẽ: http://www.mediafire...j2xlcl9tzev6jma
Cảm ơn!

Lại vấp chỗ add text rồi, hem bít sao nữa :( bạn thử dùng thằng này thay thế xem sao. Chú ý : tạo text theo style + height hiện thời, bạn nên chọn style trước nhé
(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
;(mapcar '(lambda(x) (set x nil)) '(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))
(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))))

  • 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


#25 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 13 June 2011 - 04:49 PM

Chào bạn, lại làm phiền bạn nữa rồi. Không hiểu sao có một số file cad ko sử dụng dc lisp này: nó chỉ load tới lệnh bảo chọn Hatch rồi im luôn không chạy nữa. Mình gởi kèm file cho bạn kiểm giùm. Cảm ơn bạn!
link bản vẽ: http://www.mediafire...j2xlcl9tzev6jma
Cảm ơn!

Hề hề hề,
Có nhẽ không phải vậy đâu bạn ạ. Chẳng qua có thể là do cái bản vẽ của bạn có thằng hatch tương đối lớn, lại khá rậm rì rắc rối nên việc lọc cho hết các phần tử của mảng hatch cũng tối tăm mắt mũi nên thằng lisp nó mới lò dò lâu vậy thôi. Bạn cứ chịu khó chờ dăm phút đến vài tiếng là nó sẽ chạy xong ấy mà. Có điều nếu bạn thấy thương nó thì hãy thử tắt bớt đi một vài layer hổng có liên quan tới vùng hatch ấy coi sao. Có nhẽ lisp sẽ chạy nhanh hơn vài chục lần đấy bạn ạ.
Hề hề hề,.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#26 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 June 2011 - 09:37 PM

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


#27 3d.decor

3d.decor

    biết vẽ arc

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

Đã gửi 14 June 2011 - 08:43 AM

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
  • 0

#28 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 June 2011 - 08:59 AM

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 ^^
  • 2

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


#29 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 14 June 2011 - 09:41 AM

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.
  • 0

#30 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 June 2011 - 09:58 AM

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


#31 3d.decor

3d.decor

    biết vẽ arc

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

Đã gửi 14 June 2011 - 11:13 AM

- 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
  • 0

#32 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 June 2011 - 02:57 PM

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


#33 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 15 June 2011 - 05:11 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))
)
)


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!
  • 0

#34 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 June 2011 - 09:04 PM

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 ?
  • 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


#35 3d.decor

3d.decor

    biết vẽ arc

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

Đã gửi 15 June 2011 - 09:10 PM

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 ạ
  • 0

#36 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 16 June 2011 - 10:56 AM

[quote name='ketxu' date='15 June 2011 - 09:04 PM' timestamp='1308146649' post='153365']
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
  • 0

#37 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 June 2011 - 11:36 AM


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

  • 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


#38 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 16 June 2011 - 12:37 PM

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
  • 0

#39 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 June 2011 - 01:20 PM

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!
  • 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


#40 Hoangvulandscape

Hoangvulandscape

    biết zoom

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

Đã gửi 16 June 2011 - 02:04 PM

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
  • 0