[Nhờ sửa lisp] Hatch không đè lên Dim

[toiyeuvietnam 0]

Vấn đề em đang hỏi này đã hỏi trong phần: [Đã xong] lisp Hatch (gạch, bê tông, kính) những có lẽ là không đúng bài nên các anh trong diễn đàn chưa giúp được!

em vẫn chưa có hướng giải quyết nên lại đưa vấn đề này ra mong các anh giúp và thông cảm cho em. em không biết về lisp nhưng không có lẽ là không dùng đến nó, rất mong các anh giúp cho.

em muốn khi Hatch gõ lệnh HH5 sau đó pick vào bản vẽ nó sẽ hatch và không đè lên kích thước như hình B trong bản vẽ!

ĐÂY LÀ LISP CẦN SỬA NHƯ BẢN VẼ, MONG CÁC ANH GIÚP:

http://www.cadviet.com/upfiles/3/89068_hatch_1.lsp

BẢN VẼ: http://www.cadviet.com/upfiles/3/89068_banve_1.dwg

[Tue_NV 3.912]

Vấn đề em đang hỏi này đã hỏi trong phần: [Đã xong] lisp Hatch (gạch, bê tông, kính) những có lẽ là không đúng bài nên các anh trong diễn đàn chưa giúp được!

em vẫn chưa có hướng giải quyết nên lại đưa vấn đề này ra mong các anh giúp và thông cảm cho em. em không biết về lisp nhưng không có lẽ là không dùng đến nó, rất mong các anh giúp cho.

em muốn khi Hatch gõ lệnh HH5 sau đó pick vào bản vẽ nó sẽ hatch và không đè lên kích thước như hình B trong bản vẽ!

ĐÂY LÀ LISP CẦN SỬA NHƯ BẢN VẼ, MONG CÁC ANH GIÚP:

http://www.cadviet.c...068_hatch_1.lsp

BẢN VẼ: http://www.cadviet.c...068_banve_1.dwg

Bạn tham khảo đoạn code sửa nhanh cho bạn

Lisp nhận cả Curve kín và không kín

(defun c:hh5 (/ A E E1 E2 E3 C oldhname oldhassoc kcoffset oldosmode)
 (vl-load-com)
 (command "-layer" "m" "Hatch" "c" "8" "" "")
 (setq E (entsel "\n Chon LINE/Pline/SPLINE/ARC :"))
 (setq E1 (car E))
 (SETQ A (GETPOINT "\nCHON DIEM OFFSET: "))
 (SETQ kcoffset (GETdist "\nKhoang cach OFFSET: "))

 (command "offset" kcoffset E1 A "")
 (setq C (entlast))
 (setq oldhname  (getvar "HPNAME"))
 (setq oldhassoc (getvar "HPASSOC"))
 (setq oldosmode (getvar "OSMODE"))
 (setvar "HPNAME" "ANSI31")
 (setvar "HPASSOC" 0)
 (setvar "OSMODE" 0)
 (if (vlax-curve-isClosed E1)
     (command "-hatch" (polar (CADR E) (angle (CADR E) A) (/ kcoffset 2.0)) "" "erase" C "")
     (progn
(setq E2 (entmakex (list '(0 . "LINE") 
(cons 10 (vlax-curve-getStartpoint E1))
(cons 11 (vlax-curve-getStartpoint C) ) 
 )
)
    E3 (entmakex (list '(0 . "LINE") 
(cons 10 (vlax-curve-getEndpoint E1))
(cons 11 (vlax-curve-getEndpoint C) )  
 )
)
       )
(command "-hatch"  (polar (CADR E) (angle (CADR E) A) (/ kcoffset 2.0)) "")
(command "erase" C E2 E3 "")
     )
  )

 (setvar "HPNAME" oldhname)
 (setvar "HPASSOC" oldhassoc)
 (setvar "OSMODE" oldosmode)
 (princ)
)

[toiyeuvietnam 0]

em cảm ơn anh Tue_NV đã quan tâm và giúp em! em doawload về nhưng khi dùng em pick điểm và kết thúc lệnh thì không thấy nó Hatch gì cả! anh có thể giúp em khi thực hiện lệnh nó ngắn gọn hơn, không phải chon nhiều thứ như là chọn khoảng cách OFFSET (mặc định sẵn cho tỉ lệ 500)

* anh giúp em là khi gõ lệnh HH5 -> chọn điểm cần Hatch -> vậy là hatch xong rồi. còn khoảng cách OFFSET khi Hatch đặt mặc định là 0.5 nên không phải chọn. cảm ơn anh rất nhiều!

[Tue_NV 3.912]

em cảm ơn anh Tue_NV đã quan tâm và giúp em! em doawload về nhưng khi dùng em pick điểm và kết thúc lệnh thì không thấy nó Hatch gì cả! anh có thể giúp em khi thực hiện lệnh nó ngắn gọn hơn, không phải chon nhiều thứ như là chọn khoảng cách OFFSET (mặc định sẵn cho tỉ lệ 500)

* anh giúp em là khi gõ lệnh HH5 -> chọn điểm cần Hatch -> vậy là hatch xong rồi. còn khoảng cách OFFSET khi Hatch đặt mặc định là 0.5 nên không phải chọn. cảm ơn anh rất nhiều!

Tỉ lệ Hatchscale trong Lisp, Tue_NV đặt bằng 3 giống như trong Lisp của bạn.

Bạn thử lại Lisp này nhé :

(defun c:hh5 (/ A E E1 E2 E3 C oldhname oldhassoc kcoffset oldosmode oldhSCALE)
 (vl-load-com)
 (command "-layer" "m" "Hatch" "c" "8" "" "")
 (setq E (entsel "\n Chon LINE/Pline/SPLINE/ARC :"))
 (setq E1 (car E))
 (SETQ A (GETPOINT "\nCHON DIEM OFFSET: "))
 (SETQ kcoffset 0.50)

 (command "offset" kcoffset E1 A "")
 (setq C (entlast))
 (setq oldhname  (getvar "HPNAME"))
 (setq oldhassoc (getvar "HPASSOC"))
 (setq oldhSCALE (getvar "HPscale"))
 (setq oldosmode (getvar "OSMODE"))
 (setvar "HPNAME" "ANSI31")
 (setvar "HPASSOC" 0)
 (setvar "HPscale" 3)
 (setvar "OSMODE" 0)
 (if (vlax-curve-isClosed E1)
     (command "-hatch" (polar (CADR E) (angle (CADR E) A) (/ kcoffset 2.0)) "" "erase" C "")
     (progn
(setq E2 (entmakex (list '(0 . "LINE") 
(cons 10 (vlax-curve-getStartpoint E1))
(cons 11 (vlax-curve-getStartpoint C) ) 
 )
)
    E3 (entmakex (list '(0 . "LINE") 
(cons 10 (vlax-curve-getEndpoint E1))
(cons 11 (vlax-curve-getEndpoint C) )  
 )
)
       )
(command "-hatch"  (polar (CADR E) (angle (CADR E) A) (/ kcoffset 2.0)) "")
(command "erase" C E2 E3 "")
     )
  )

 (setvar "HPNAME" oldhname)
 (setvar "HPASSOC" oldhassoc)
 (setvar "HPscale" oldhSCALE)
 (setvar "OSMODE" oldosmode)
 (princ)
)

[Doan Van Ha 3.196]

Nếu chỉ chọn 1 thứ (curve chẳng hạn) để hatch, và với riêng bài toán của bạn thì bạn thử cái này xem sao.

P/S: sửa lúc 13h45 - 14/01/2012.

;Doan Van Ha - CADViet.com - Ngay 14/01/2012
;Muc dich: Ve Hatch ben trong Curve kin, be day 0.5, khong de len Dim, chi can chon curve.
(defun C:HA (/ obj obj1 obj2 q dau)
(vl-load-com)
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "undo" "be")
(command "-layer" "m" "Hatch" "c" "8" "" "")
(setq obj (vlax-ename->vla-object (setq ent (car (entsel "\nChon duong bao:")))))
(if (equal (cdr (assoc 0 (entget ent))) "CIRCLE") (setq dau -1) (setq dau 1))
(setq obj1 (car (vlax-invoke obj 'Offset (* dau 0.25))))
(setq q (vlax-curve-getStartPoint obj1))
(vla-Delete obj1)
(setq obj2 (car (vlax-invoke obj 'Offset (* dau 0.50))))
(command "bhatch" "p" "ANSI31" 3 0 "A" "I" "Y" "S" "N" "" q "")
(command "chprop" (entlast) "" "la" "hatch" "")
(vla-Delete obj2)
(command "undo" "e")
(setvar "cmdecho" cmdold)
(princ))

[toiyeuvietnam 0]

em cảm ơn anh TUE và Anh Ha, không biết sao em dùng lisp của anh TUE thì khi hatch nó có chớp khung bao xong rồi không hiện nét hatch lên, còn lisp của anh Ha thì hatch được nhưng hatch cả hình chứ không hatch khoảng 0.5 xung quanh hình. cái đoạn lisp ban đầu em gửi nó đơn giản hơn chỉ cần gõ lệnh xong là chọn vào tâm khung hình (dùng được cả đường Line và Pline) vậy là xong nhưng nó lại đè lên Dim. nhờ các anh giúp nó không đè lên dim là ok. rất chân thành cảm ơn các anh đã giúp nhiệt tình!

[Doan Van Ha 3.196]

em cảm ơn anh TUE và Anh Ha, không biết sao em dùng lisp của anh TUE thì khi hatch nó có chớp khung bao xong rồi không hiện nét hatch lên, còn lisp của anh Ha thì hatch được nhưng hatch cả hình chứ không hatch khoảng 0.5 xung quanh hình. cái đoạn lisp ban đầu em gửi nó đơn giản hơn chỉ cần gõ lệnh xong là chọn vào tâm khung hình (dùng được cả đường Line và Pline) vậy là xong nhưng nó lại đè lên Dim. nhờ các anh giúp nó không đè lên dim là ok. rất chân thành cảm ơn các anh đã giúp nhiệt tình!

Tôi đã test trên bản vẽ của bạn rồi mà sao vẫn như bạn nói được nhỉ? Chỉ là nó không hatch được khi bao của nó là line thôi. Bạn có thể gởi lại bản vẽ bị lỗi lên xem sao hè.

[Tue_NV 3.912]

em cảm ơn anh TUE và Anh Ha, không biết sao em dùng lisp của anh TUE thì khi hatch nó có chớp khung bao xong rồi không hiện nét hatch lên, còn lisp của anh Ha thì hatch được nhưng hatch cả hình chứ không hatch khoảng 0.5 xung quanh hình. cái đoạn lisp ban đầu em gửi nó đơn giản hơn chỉ cần gõ lệnh xong là chọn vào tâm khung hình (dùng được cả đường Line và Pline) vậy là xong nhưng nó lại đè lên Dim. nhờ các anh giúp nó không đè lên dim là ok. rất chân thành cảm ơn các anh đã giúp nhiệt tình!

Ít ra bạn cũng nên cho biết mình biết bạn gặp lỗi gì chứ bạn?

File của bạn được Test bằng Lisp của Tue_NV viết ở đây, bạn xem thử:

http://www.cadviet.com/upfiles/3/4652_test.dwg

[Doan Van Ha 3.196]

Cái này chỉ cần chọn 1 điểm trong vùng cần Hatch. Nếu bạn sử dụng còn lỗi mà không post bản vẽ lên thì tôi không thể tìm ra được.

;Doan Van Ha - CADViet.com - Ngay 14/01/2012
;Muc dich: Ve Hatch ben trong Curve kin, be day 0.5, khong de len Dim, chi can chon 1 diem trong vung.
(defun C:HA (/ p ent1 ent2 ent3 q)
(vl-load-com)
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "undo" "be")
(command "-layer" "m" "Hatch" "c" "8" "" "")
(setq p (getpoint "\nChon 1 diem trong vung can Hatch: "))
(command "boundary" "a" "i" "no" "" "" p "")
(setq ent1 (entlast))
(command "offset" 0.50 ent1 p "")
(setq ent2 (entlast))
(command "offset" 0.25 ent1 p "")
(setq ent3 (entlast))
(setq q (vlax-curve-getStartPoint (vlax-ename->vla-object ent3)))
(command "erase" ent3 "")
(command "bhatch" "p" "ANSI31" 3 0 "A" "I" "Y" "S" "N" "" q "")
(command "chprop" (entlast) "" "la" "hatch" "")
(command "erase" ent1 ent2 "")
(command "undo" "e")
(setvar "cmdecho" cmdold)
(princ))

[Doan Van Ha 3.196]

Ít ra bạn cũng nên cho biết mình biết bạn gặp lỗi gì chứ bạn?

File của bạn được Test bằng Lisp của Tue_NV viết ở đây, bạn xem thử:

http://www.cadviet.c...3/4652_test.dwg

Bác Tue_NV!

1). Chọn line không được.

2). Bác thiếu khi đặt chế độ hatch nên 50/50 nó hatch không đúng. Tham khảo:

(command "bhatch" "p" "ANSI31" 3 0 "A" "I" "Y" "S" "N" "" q "")

3). Sẵn nhờ bác test cái của tôi và góp ý luôn cho. Tôi đã test thì ok.

[ketxu 2.984]

Đông vui quá, E góp vui 1 code nhanh, mới chỉ test thử hình bạn ấy post

(defun c:h5(/ lstObj e p1 p2 Obj ObjB oldVal lstVar pt)
(command "undo" "be")
(setq oldVal (mapcar 'getvar (setq lstVar '("HPNAME" "CMDECHO" "OSMODE" "HPASSOC" "HPGAPTOL"))))
(mapcar 'setvar lstVar '("ansi31" 0 0 0))
(or *kc* (setq *kc* 0.5))
(setq *kc* (cond ((getdist (strcat "\nKhoang cach Offset de Hatch < " (rtos *kc* 2 2) " > :")))(*kc*)))
(command "-layer" "m" "Hatch" "c" "8" "" "")
(while (setq pt (getpoint "\n Pick diem ben trong vung Hatch :"))
(setq e (entlast) lstObj nil)
(command "boundary" pt "")
(cond ((not (eq e (entlast)))
  (while (setq e (entnext e))(setq lstObj (cons (vlax-ename->vla-object  e) lstObj)))
  (setq   Obj (car (vlax-invoke  (setq ObjB (car lstObj))  'Offset (- *kc*)))
p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getStartPoint objB)
  )
  (command "-bhatch"  (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) "")
  (while (/= (cdr (assoc 0 (entget (entlast)))) "HATCH")
(command "-bhatch"  (getpoint "\nChuong trinh gap loi khi tu dong tinh diem Hatch , ban hay chi dinh diem giua 2 bien Hatch :") ""))  
  (mapcar 'vla-delete (cons obj lstObj))
  (mapcar 'setvar lstVar oldVal)
  )
 (T (princ "\n Gap loi - chua ro nguyen nhan "))
)
)
(command "undo" "en")
)

[Doan Van Ha 3.196]

Đông vui quá, E góp vui 1 code nhanh, mới chỉ test thử hình bạn ấy post

(defun c:h5(/ lstObj e p1 p2 Obj ObjB oldVal lstVar pt)
(command "undo" "be")
(setq oldVal (mapcar 'getvar (setq lstVar '("HPNAME" "CMDECHO" "OSMODE" "HPASSOC" "HPGAPTOL"))))
(mapcar 'setvar lstVar '("ansi31" 0 0 0))
(or *kc* (setq *kc* 0.5))
(setq *kc* (cond ((getdist (strcat "\nKhoang cach Offset de Hatch < " (rtos *kc* 2 2) " > :")))(*kc*)))
(command "-layer" "m" "Hatch" "c" "8" "" "")
(while (setq pt (getpoint "\n Pick diem ben trong vung Hatch :"))
(setq e (entlast) lstObj nil)
(command "boundary" pt "")
(cond ((not (eq e (entlast)))
  (while (setq e (entnext e))(setq lstObj (cons (vlax-ename->vla-object  e) lstObj)))
  (setq   Obj (car (vlax-invoke  (setq ObjB (car lstObj))  'Offset (- *kc*)))
p1 (vlax-curve-getStartPoint obj)
p2 (vlax-curve-getStartPoint objB)
  )
  (command "-bhatch"  (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) "")
  (while (/= (cdr (assoc 0 (entget (entlast)))) "HATCH")
(command "-bhatch"  (getpoint "\nChuong trinh gap loi khi tu dong tinh diem Hatch , ban hay chi dinh diem giua 2 bien Hatch :") ""))  
  (mapcar 'vla-delete (cons obj lstObj))
  (mapcar 'setvar lstVar oldVal)
  )
 (T (princ "\n Gap loi - chua ro nguyen nhan "))
)
)
(command "undo" "en")
)

Ket ơi, lỗi như bác Tue_NV rồi!

[ketxu 2.984]

Ket k test các biến khác nên cũng chưa để ý lỗi nào, nếu 50/50 thì bác show luôn cái lỗi để sửa bác ạ ^^

[Doan Van Ha 3.196]

Ket k test các biến khác nên cũng chưa để ý lỗi nào, nếu 50/50 thì bác show luôn cái lỗi để sửa bác ạ ^^

Chỗ này Ket: Islands trong dialoge hatch đấy. Trong code của tôi có xét tới nó. Với lại, Ket test giùm cái tôi viết sau cùng coi nó có lỗi không nhé.

[ketxu 2.984]

Của bác e test từ lúc bắt đầu viết code kia, chạy bình thường :)

Do bình thường ket thấy Is cứ ở chế độ Detection In nên cũng k để ý đến cái này, cảm ơn bác đã nhắc, vậy nếu bạn TVYE có nghịch cái của Ket thì nhớ thêm mấy Option giống dòng command của bác ĐVH nhé ^^

[toiyeuvietnam 0]

cảm ơn các anh, cảm ơn anh Hà đã giúp em giải quyết được vấn đề rồi! chúc các anh và diễn đàn CAD Viet 1 năm cũ vui vẻ chuẩn bị qua, 1 năm mới tốt đẹp sắp tới với mọi sự thuận lợi đến với mọi người