Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
ketxu

[Đã xong] Lisp gộp Hatch Pattern

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

Xuất phát từ topic này

http://www.cadviet.c...75

Tranh thủ giờ nghỉ trưa ketxu viết tặng mọi người cái này xài chơi (có khi chẳng dùng hoặc dùng 1 lần duy nhất ^^)

Lisp add toàn bộ Hatch Pattern trong các file PAT từ 1 thư mục (và các thư mục con) vào bảng Hatch của CAD (ghi thêm vào acad.pat và acadiso.pat), đỡ phải add thêm support Patch cho Hatch. Có thể áp dụng làm các việc tương tự. Chúc các bác ngon giấc ^^

Open Source :

(defun c:Add-Hatch( / ST:UI-Nil-Alert ST:File_GetAll Browse patFolder lstFiles isoFile iso1File pat1 pat2)
;@ Ketxu 13 - 9 - 11
; Add Hatch to Acad, Acadiso.pat

(grtext -1 "Assign Hatch Pattern Working ! @Ketxu ")

; =====================================================
; ============= Local Function ========================
; =====================================================

;| ======= ST:UI-Nil-Alert ============================
Alert if a value in LIST is Nil
Base on pBe CADTUTOR
@Ketxu 14 - 9 - 11
|;
(defun ST:UI-Nil-Alert ( msgDefault lst  / x )
(if (setq x (vl-some '(lambda ( x ) (if (null (eval (car x))) (cadr x))) lst))
 	(alert (strcat msgDefault x))
)
)

;| ======= ST:File_GetAll =============================
Get all Files in subs Directory by match
Base on Lee Mac
@Ketxu 14 - 9 - 11
|;
(defun ST:File_GetAll ( Dir typ )
 (append (mapcar '(lambda ( x ) (strcat Dir "\\" x)) (vl-directory-files Dir typ 1))
(apply 'append
 	(mapcar '(lambda ( x ) (ST:File_GetAll (strcat dir "\\" x) typ))
   	(cddr (vl-directory-files dir "*" -1))
 	)
)
 )
)
;| ======= Browse =====================================
Get folder UI
@ Lee Mac
|;
(defun Browse ( msg dir flag / Shell Fold Self Path ) ;@Lee Mac
(vl-catch-all-apply
 	(function
   	(lambda ( / ac HWND )
     	(if
       	(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
             	HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
             	Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir)
       	)
       	(setq Self (vlax-get-property Fold 'Self)
             	Path (vlax-get-property Self 'Path)
             	Path (vl-string-right-trim "\\" (vl-string-translate "/" "\\" Path))
       	)
     	)
   	)
 	)
)
(if Self  (vlax-release-object  Self))
(if Fold  (vlax-release-object  Fold))
(if Shell (vlax-release-object Shell))
Path
 )
; =====================================================
; ============ Start Rountine =========================
; =====================================================
(cond  
   ((and
       (setq patFolder (Browse "Select Folder Contains PAT File : \n\t(Work With Sub Folder Also)" nil 0))
       (setq lstFiles (ST:File_GetAll patFolder "*.PAT"))
       (setq isoFile (open (setq pat1 (findfile "acadiso.pat")) "a"))
       (setq iso1File (open (setq pat2 (findfile "acad.pat")) "a"))
	)
	(mapcar '(lambda(x)
  	     (setq tmpOpen (open x "r"))
  	     (while (setq Line (read-line tmpOpen))
  			     (write-line Line isoFile)
  			     (write-line Line iso1File)
  	     )
  	     (close tmpOpen)
  	     )
       lstFiles
   )
   (close isoFile)
(close iso1File)
   (initget "Y N y n")
   (setq ans (getkword "B\U+1EA1n c\U+00F3 mu\U+1ED1n l\U+01B0u l\U+1EA1i file PAT th\U+00EAm 1 b\U+1EA3n kh\U+00E1c ? [Y / N]"))
   (cond ((= ans "Y")
  	     (if(setq patSave (getfiled "File name to save ?" "PAT_back" "pat" 1))
  		     (and (vl-file-copy pat1 (strcat (vl-string-right-trim ".pat" patSave) "-1.pat"))
  			     (vl-file-copy pat2 (strcat (vl-string-right-trim ".pat" patSave) "-2.pat"))
  		     )
  	     )
  	     )
   )
   (alert "Qu\U+00E1 tr\U+00ECnh th\U+00EAm Hatch \U+0111\U+00E3 ho\U+00E0n t\U+1EA5t.\nC\U+00E1c Hatch Pattern \U+0111\U+00E3 \U+0111\U+01B0\U+1EE3c th\U+00EAm v\U+00E0o m\U+1EE5c Other Predefined !!")
   )
   (T    (ST:UI-Nil-Alert "Qu\U+00E1 tr\U+00ECnh th\U+00EAm Hatch Pattern b\U+1ECB l\U+1ED7i !\n"
  	     '((patFolder "B\U+1EA1n ch\U+01B0a ch\U+1ECDn th\U+01B0 m\U+1EE5c ch\U+1EE9a file PAT")
  		     (lstFiles "Trong th\U+01B0 m\U+1EE5c b\U+1EA1n ch\U+1ECDn (v\U+00E0 c\U+00E1c th\U+01B0 m\U+1EE5c con) kh\U+00F4ng ch\U+1EE9a file PAT n\U+00E0o")
  		     (isoFile "Kh\U+00F4ng t\U+00ECm th\U+1EA5y file acadiso.pat")
  		     (iso1File "Kh\U+00F4ng t\U+00ECm th\U+1EA5y file acad.pat")
  	     )
       )
   )
)
)

  • Vote tăng 3

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

hà hà. tạm dừng viết lisp free mà vẫn post đều đều thế hả ketxu? Cái này cũng hay đấy, đỡ ngại mỗi lần fải cài lại cad.

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

Tạm dừng tức là em không quay theo yêu cầu thôi, còn share cái gì vui vui thì vẫn share chứ ^^ Cái lisp chỉ là ví dụ, còn cái em muốn share là các hàm trong đó thôi. ^^ Khi mọi người gom đu đủ bộ hàm cho mình rồi thì viết 1 chương trình nhỏ nhỏ trở nên dễ như thổi cơm điện thôi ^^

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

Ket nói là làm hử!

Rất tiện lợi, khỏi phải add vào support path, khỏi phải chỉnh sửa file hatch

  • Vote tăng 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

Lisp phát huy tác dụng tốt khi có nhiều file PAT nằm trong các thư mục khác nhau (add support hết cũng mệt lắm :rolleyes: :rolleyes: ) và nhân tiện backup lại 1 file luôn :rolleyes:

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

Ủa cái này quá tuyệt vời, cám ơn Ketox, em tìm mãi mà không được, may quá có cái lisp này, vì em có chương trình dùng chạy sử dụng cho Địa chất mà không biết đăng ký các PAT thế nào cả! Thanks All!

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

Nó có yêu cầu save file .pat lại nhưng ko biết đó là file .pat trước khi gộp lại hay sau khi gộp lại vậy a? Nếu e mún tách ra lại thì phải làm sao vậy a?

thanks!

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

mình ladd hatch dc rồi nhưng trong số file hatch add thêm đó có 1 file hatch bị lỗi nên giờ mỗi lần hatch là nó báo lỗi, phải click "ok" khoảng 50 lần thì mới tiếp tục hatch dc. Ko biết làm sao để remove mấy file hatch đã add để trở về như cũ đây? lúc trc quên save lại file .pat rồi.

bạn nào có thể cho mình xin file "acad.pat" và file "acadiso.pat" của cad 2014 ko?

thanks!

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

cảm ơn a! e  trả nó vể như cũ dc rồi.

dùng cak truyền thống cho an tâm! mấy hôm nay ko hatch dc gì cả!

Giờ kiểm tra lại thì cái hatch đó ko bị lỗi nhưng ko hiểu sao khi add hatch thì lại báo lỗi, hic...

 

P/S: làm sao thêm được hatch "BTCT" vào trong tab "other Predefined" như trong file hatch của a vậy?

thanks!

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

:D :D :D

2 lúa cũng không biết nữa, copy+paste thôi. 

@ketxu: Chắc ket có tuyệt chiêu rồi. Nguyên đoạn code \u+************** thế kia 2 lúa dòm xong cũng thấy ************ luôn.

:D :D :D

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×