Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu]Lisp hatch nhanh theo layer


  • Please log in to reply
13 replies to this topic

#1 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 09:52 AM

Em muốn hatch nhiều vùng kín được tạo từ các layer, mà chỉ cần chọn theo layer không phải pick điểm hoặc chọn đối tượng. Ví dụ như trong hình vẽ có 3 layer với 3 màu khác nhau, bây h muốn hacth theo trong vùng kín được tạo bởi layer màu xanh và màu vàng chẳng hạn thì chỉ cần chọn layer không cần pick điểm. Nếu pick điểm thì rất mất thời gian. Xin cám ơn!Hình đã gửi
  • 0

#2 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 10:06 AM

Rất mong các pro ghé qua topic này!
  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 March 2012 - 10:26 AM

Hiểu ý bạn nhưng để làm được k phải dễ ^^
Topic chưa có file minh họa, đầu vào đầu ra (chọn layer ntn, bnhieu layer, hatch ra sao....)
  • 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


#4 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 10:50 AM

file đây bác, không biết thế đã đủ chưa. Yêu cầu là: hatch các vùng tạo bởi 2 layer, chọn 2 layer, hatch được bình thường như pick điểm hoặc chọn đối tượng.
http://www.cadviet.c...40_drawing1.dwg
Thanks!
  • 0

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 13 March 2012 - 01:17 PM

file đây bác, không biết thế đã đủ chưa. Yêu cầu là: hatch các vùng tạo bởi 2 layer, chọn 2 layer, hatch được bình thường như pick điểm hoặc chọn đối tượng.
http://www.cadviet.c...40_drawing1.dwg
Thanks!

Bạn thử nhé :


(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt name tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" name tle goc "S" dt "" "")
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(if (setq ss (ssget '((0 . "*POLYLINE") (8 . "NVSS"))))
(Progn
;(command "hatch" "P" "ANSI31" "1" "0" "")
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq ss2 (ssget "f" (Tue-ent-Lpoint ename) '((0 . "*POLYLINE") (8 . "NVSS,TUNHIEN"))))
(lh ss2 "ANSI31" "1" "0")
)
))
)

  • 4

#6 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 02:00 PM

Thanks bác nhiều!
Mong bác phát triển thêm chút nữa:
1/ Không nhất thiết phải dùng mẫu hatch "ANSI31", có thể tùy chọn mẫu hatch tùy ý như hatch bình thường;
2/ Các layer chọn không nhất thiết phải đúng tên "NVSS" hay "TUNHIEN", có thể chọn 2 layer khác nhau cùng lúc.
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 March 2012 - 02:17 PM

Thanks bác nhiều!
Mong bác phát triển thêm chút nữa:
1/ Không nhất thiết phải dùng mẫu hatch "ANSI31", có thể tùy chọn mẫu hatch tùy ý như hatch bình thường;
2/ Các layer chọn không nhất thiết phải đúng tên "NVSS" hay "TUNHIEN", có thể chọn 2 layer khác nhau cùng lúc.

Sao cứ để phải viết đi viết lại thế 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


#8 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 02:23 PM

Sao cứ để phải viết đi viết lại thế bạn ?

Hix. Mong bác bỏ quá cho em. Nếu có thể thì bác viết lại cho em với!
  • 0

#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 March 2012 - 03:35 PM

Sửa lại 1 chút theo ý bạn, còn nguyên lý làm việc vẫn giữ nguyên ý bác Tuệ, chạy mượt hay không bạn tìm bác ấy nhé :)

(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh ent fl)
(setq fl "")
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" (getvar "hpname") tle goc "S" dt "" "")
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(while (setq ent (entsel "\nDoi tuong chua layer mau :"))
(setq lay (Tue-dxf 8 (car ent))
fl (cond ((not (wcmatch lay fl))(strcat fl lay ",")))
)
)
(setq fl (vl-string-left-trim "," fl))
(if (setq ss (ssget (list (cons 0 "*POLYLINE")
(cons 8 (cond ((setq tmp (vl-string-search "," fl)) (substr fl 1 (vl-string-search "," fl)))
(fl)
)))))
(Progn
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq ss2 (ssget "f" (Tue-ent-Lpoint ename) (list (cons 0 "*POLYLINE") (cons 8 fl))))
(lh ss2 "1" "0")
)
))
)

  • 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


#10 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 March 2012 - 04:22 PM

Sửa lại 1 chút theo ý bạn, còn nguyên lý làm việc vẫn giữ nguyên ý bác Tuệ, chạy mượt hay không bạn tìm bác ấy nhé :)


(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh ent fl)
(setq fl "")
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" (getvar "hpname") tle goc "S" dt "" "")
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(while (setq ent (entsel "\nDoi tuong chua layer mau :"))
(setq lay (Tue-dxf 8 (car ent))
fl (cond ((not (wcmatch lay fl))(strcat fl lay ",")))
)
)
(setq fl (vl-string-left-trim "," fl))
(if (setq ss (ssget (list (cons 0 "*POLYLINE")
(cons 8 (cond ((setq tmp (vl-string-search "," fl)) (substr fl 1 (vl-string-search "," fl)))
(fl)
)))))
(Progn
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq ss2 (ssget "f" (Tue-ent-Lpoint ename) (list (cons 0 "*POLYLINE") (cons 8 fl))))
(lh ss2 "1" "0")
)
))
)

Cám ơn bác nhiều nhé!
Nhưng hình như bác mới sửa được một ý thứ 2 trong 2 ý mà em muốn.
Còn lựa chọn mẫu hatch và scale nữa.
Mong bác giúp đỡ!
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 March 2012 - 05:37 PM

Ý 1 : nếu muốn thao tác chọn mẫu Hatch như lệnh nguyên thủy thì k làm hàng loạt ngay được, vì hộp thoại trong thao tác chuẩn là để làm từng lần 1. Có thể thay đổi bằng cách bắt bạn nhập vào tên mẫu Hatch ngay ban đầu, nhưng như thế còn khó chịu hơn, liệu bạn có nhớ tên mẫu Hatch cần Hatch ?. Mình đang để lấy mẫu Hatch hiện tại, vì vậy bạn có thể linh hoạt hatch bằng loại mình muốn trc khi dùng lisp
- Ý 2 : chọn nhiều đối tượng để lấy tên layer, k nhất thiết là 2 (có thể 1,3...)
- Ý 3 : về tỉ lệ, ý này bạn vừa nói, trong bài trước không có. Trả lời tương tự ý 1, có thể làm bằng cách thay "1" trong dòng (lh ss2 "1" "0") thành (getreal "\nTi le :")
- Ý 1 + Ý 3 : thay vì chờ người viết, bạn có thể cứ sử dụng lisp rồi chọn hàng loạt Hatch, ấn Ctrl 1 và sửa. Chủ động giải quyết vấn đề k hơn sao :)
  • 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


#12 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 13 March 2012 - 05:48 PM

Sau khi chọn xong đối tượng có Layer mẫu -> quét chọn đối tượng

-> Lisp sẽ gọi hộp thoại Hatch cho bạn lựa chọn mẫu hatch và scale , angle
Bạn nhấn nút Select Object -> OK trong hộp thoại Hatch là xong
đây là Code :
[Code]
(defun c:hlay(/ ss Tue-dxf Tue-ent-Lpoint ename ename2 ss2 lh ent fl)
(setq fl "")
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun lh(dt tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" (getvar "hpname") tle goc "S" dt "" "")
)
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
(if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
(setq i -1)
(Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
(setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
)
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
(setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
(while (setq ent (entsel "\nDoi tuong chua layer mau\Enter ket thuc"))
(setq lay (Tue-dxf 8 (car ent))
fl (cond ((not (wcmatch lay fl))(strcat fl lay ",")))
)
)
(setq fl (vl-string-left-trim "," fl))
(if (setq ss (ssget (list (cons 0 "*POLYLINE")
(cons 8 (cond ((setq tmp (vl-string-search "," fl)) (substr fl 1 (vl-string-search "," fl)))
(fl)
)))))
(Progn
(setq i -1) (initdia) (command "bhatch")
(while (setq ename (ssname ss (setq i (1+ i))))
(setq ss2 (ssget "f" (Tue-ent-Lpoint ename) (list (cons 0 "*POLYLINE") (cons 8 fl))))
(lh ss2 (getvar "Hpscale") (getvar "hpang"))
)
))
)
[/code]

Không biết thế nào mà code không chịu vào thẻ nữa
  • 1

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 13 March 2012 - 06:19 PM

Cần phải xét thêm trường hợp khi kiểu hatch là SOLID nữa!
  • 1

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


#14 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 14 March 2012 - 10:18 AM

Thanks tất cả các bác nhé!
  • 0