Chuyển đến nội dung
Diễn đàn CADViet

Bee

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    553

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    37

Bài đăng được đăng bởi Bee

  1. Đã đăng · Trả lời báo cáo

    19 giờ trước, dinhvantrang đã nói:

    Gửi mr Bee kiểm tra thử nhé.Mình viết bằng vbscripting

    Cách chạy:

    Giải  nén và bỏ file giải nén đó vào trong Folder chứa các file cần Rename >>Run.

    MrBee.rar

    Mr Trang cho hỏi mở rộng hơn tí. ^_^

     

    Trường hợp mà ko có "_" mà chỉ space (thường có trong các file có tiếng việt) thì code VBS thế nào ?

     

  2. Đã đăng · Trả lời báo cáo

    32 phút trước, quocmanh04tt đã nói:

    Thử chạy bằng LISP coi sao!

    ((lambda (/ name new_filename)
       (defun new_filename  (filename / LM:str->lst lst)
         (defun LM:str->lst  (str del / pos)
           (if (setq pos (vl-string-search del str))
             (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
             (list str)))
         (setq lst (vl-remove-if '(lambda (x) (vl-string-search (chr 63) x))
                                 (LM:str->lst filename (chr 95))))
         (strcat (car lst) (apply 'strcat (mapcar '(lambda (x) (strcat (chr 95) x)) (cdr lst)))))
       (vlax-for f  (vlax-get (vlax-invoke-method
                                (vlax-create-object "Scripting.FilesystemObject")
                                'GetFolder
                                "D:\\TEMP")
                              'Files)
         (if (and (vl-string-search (chr 63) (setq name (vlax-get f 'name)))
                  (eq (strcase (vl-filename-extension name)) ".DWG"))
           (vlax-put f 'name (new_filename name))))))

    P/s:

    + Nếu thêm Browse Folder thì "Pờ - rồ" hơn, nhằm thay thế  "D:\\TEMP".

    + Chưa bắt, bẫy lỗi trùng tên file sau khi rename...

    Ok thanks Mr quocmanh. Để em chạy thử.

    Browse Folder thì dùng thằng này cũng nhanh gọn: (acet-ui-pickdir "Select Directory")) 

  5. Đã đăng · Trả lời báo cáo

    3 giờ trước, quocmanh04tt đã nói:

    Tạm thế này rồi có thể dựa vào đó nghiên cứu tiếp:

    (vl-list->string (vl-remove 63 (vl-string->list (car (vl-directory-files "C:\\TEMP" "*.dwg" 1)))))

    Quả này em thử roài.! Nhưng mà lúc rename ko được: 

    ("20180220_APARTMENT TYPE 1_????1_Block A.dwg")

     

    ????? thế sao rename được. ^_^

     

     

  11. Đã đăng · Trả lời báo cáo

    Vào lúc 25/1/2018 tại 15:08, bEan đã nói:

    Chào các bác em có bản vẽ này khi in sử dụng nét in đen trắng monochorme nhưng khi preview thì lại có màu, ko hiểu tại sao. Bác nào cao thủ giúp em với ạ

    Em cảm ơn ạ

    18.01.24 BV Dae Won.dwg

    Không biết file đính kèm này có đúng ý không ^_^

    18.01.24 BV Dae Won.dwg

  12. Đã đăng · Trả lời báo cáo

    10 giờ trước, nhimret đã nói: 
    
;; Convert Layer cua cac doi tuong ben trong block (co the long nhau) ve cung Layer cua Block chinh. De Undo tat ca: dung lenh "U" + "Regen"
; Doan Van Ha - CadViet.com - ngay 21/7/2013
(defun C:zz ( / doc blkname lay)
 (princ "\nChon cac Blocks...")
 (if (ssget '((0 . "INSERT")))
  (progn
   (vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
    (setq blkname (vla-get-Name obj)
          lay (vla-get-Layer obj))
    (mapcar '(lambda(o) (vla-put-Layer o lay)) (Get_lst_Obj doc blkname)))
   (vla-Regen doc acActiveViewport))))
(defun Get_lst_Obj (doc blkname / lst)
 (vlax-for blk (vla-Item (vla-get-Blocks doc) blkname)
  (if (/= (vla-get-ObjectName blk) "AcDbBlockReference")
   (if (not (vl-position blk lst))
    (setq lst (cons blk lst)))
   (setq lst (append (Get_lst_Obj doc (vla-get-Name blk)) lst)))))

    Tôi đang dùng lisp của bác @Doan Van Hamấy năm rất hiệu quả, nhưng hiện giờ gặp một vấn đề là nếu như đối tượng trong layer không để bylayer, mà để màu tự chọn, thì lisp này không đổi được màu của nó, chỉ đổi layer.

     

    Nhờ các bác chỉnh sửa hộ lisp này để gõ lệnh thì các đối tượng trong layer chuyển được về hết bylayer hộ. 

     

    Cám ơn rất nhiều

    Thử thay xem thế nào ^_^:

    (mapcar '(lambda(o) (vla-put-Layer o lay)) (Get_lst_Obj doc blkname)))

    thành:

    (mapcar '(lambda(o) (vla-put-Layer o lay) (vla-put-color o 256)) (Get_lst_Obj doc blkname))

    • Like 1

  14. Đã đăng · Trả lời báo cáo

    16 phút trước, nguyễn đức hiểu đã nói:

    mọi người cho em hỏi trong cad có cách nào để chỉnh sửa kích cỡ text giống hệt như cỡ size trong word không ạ. vì theo em được biết giả sử cỡ size trong word là 50 thì khi in ra giấy A0 thực tế thì sẽ có chiều cao là 54 mm. em đang làm một  bản vẽ theo hướng dẫn thì theo size word mà không biết quy đổi kích cỡ sang cad như thế nào. rất mong mọi người giúp em.

     

    Size font word là 72 (point) = 1 inch = 25.4 mm trong CAD. Suy ngược ra Font Word 12 thì CAD là xxxxx ^_^ lẻ tung tóe. 

  20. Đã đăng · Trả lời báo cáo

    49 phút trước, DuongTrungHuy đã nói:

    À không đâu Bee ơi mình đang xài Cad 2014 đó, hì bgiờ ai còn dung cad14 nữa, hồi đầu mình xài cad12 hay trước đó thì phải, trước đây cad không đặt tên theo năm nên có cad14 v.v...

    Mình viết LISP từ 1992 kia.  Cũng vì xài đồ cổ nên thấy mấy từ vla-get v.v... là lại sợ nên ít dùng.

    Cám ơn Bee đã quan tâm. (Tâm sự đại chúng cho vui vậy)

    Ồi bác công lực thâm hậu thế thì update lên VLisp sử dụng cho nhanh hơn và nhàn hơn. 

    VD: hàm vl-sort bác lập hàm nào bên Autolisp để được như nó thì cũng mất thời gian và công sức hơn. Đây Autodesk họ xây dựng sẵn cho mình vận dụng thì mình tận dụng nó , Tốc độ Nhanh và nhàn hơn là tự xây dựng 1 hàm riêng. ^_^  Mà chém vui thế thoai, tùy nhu cầu của mỗi người nên sẽ khác nhau. Bác Huy đọc cho vui. ^_^

    • Like 1

  21. Đã đăng · Trả lời báo cáo

    4 phút trước, DuongTrungHuy đã nói:

    Hì cám ơn Bee.

    Mình quen viết kiểu chân phương như vậy, chưa quen dùng các hàm kiểu Vla v.v... cái náy là mình trích từng đoạn trong bộ lisp của mình.

    Các hàm con như tìm các block đó được viết từ ngày mới tập viết lisp qua các sách hướng dẫn, hì hì trông có vẻ mô phạm.

    Quen rồi bây giờ cứ cần là lại lôi nó ra cho mau chứ ngại thay đổi. (Mình chưa quen thì thấy cái của Bạn lại hoa cả mắt hơn  :-):-):-))

    Chắc bác quen sài từ CAD14 ^_^ Up lên CAD 2000 đi bác, từ CAD 2000 nó có VLisp rồi mà.

  22. Đã đăng · Trả lời báo cáo

    58 phút trước, DuongTrungHuy đã nói:

    Nếu Quang gặp khó khăn khi muốn trở về màu thành Bylayer thì dùng cái này thử xem.

    Xài tạm vì chưa thử nhiều (mới thử trên bản vẽ của Bạn sau khi cùng lệnh ColorX của Tây).

    Lệnh là:    Re_Color

     

    (Defun LaydsBlock(/ ds dsphu ds1)
      (setq ds (tblnext "Block"T) dsBlock (list (cdr (assoc 2 ds))) dsphu (list (cons (cdr (assoc 2 ds)) (list ds))))
      (while (/= ds nil)
        (setq ds (tblnext "Block") ds1 (cdr (assoc 2 ds)))
        (if (/= ds nil)
        (Progn
          (If (/= (substr ds1 1 1) "*")
          (Setq dsBlock (append dsBlock (list ds1)) dsphu (append dsphu (list (cons ds1 (list ds))))))
        )
        )
      )
    )  


    (Defun c:Re_Color()  
      (LaydsBlock)
      (command "Undo" "be")  
      (Foreach pt dsblock
        (command "bedit" pt) (command "change" "all" "L" "" "P" "COLOR" "Bylayer" "") (command "BCLOSE" "")
      )
      (command "change" "all" "L" "" "P" "COLOR" "Bylayer" "")
      (command "Undo" "e")  
    )

    Hì hì, bác Huy tham khảo cái này, chứ làm theo của bác em thấy hơi hoa mắt ^_^ 

    acbylayer  

    ;;;Lee_Mac
(defun c:test  (/ d)
  (vlax-for b  (vla-get-blocks (setq d (vla-get-activedocument (vlax-get-acad-object))))
    (if (and (= :vlax-false (vla-get-isxref b)) (not (wcmatch (vla-get-name b) "`*D*,_*")))
      (vlax-for o b (vl-catch-all-apply 'vla-put-color (list o acbylayer)))
      )
    )
  (vla-regen d acallviewports)
  (princ)
  )
(vl-load-com)
(princ)

     

  25. Đã đăng · Trả lời báo cáo

    2 phút trước, hoavienquang đã nói:

    có cái lisp này nhưng em ko biết lệnh là gì

     

     

    (defun mip:layer-status-restore () (foreach item *MIP_LAYER_LST* (if (not (vlax-erased-p (car item))) (vl-catch-all-apply '(lambda () (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item)))) ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of if ) ;_ end of foreach (setq *MIP_LAYER_LST* nil) ) ;_ end of defun (defun mip:layer-status-save () (setq *MIP_LAYER_LST* nil) (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq *MIP_LAYER_LST* (cons (list item (cons "freeze" (vla-get-freeze item)) (cons "lock" (vla-get-lock item)) ) ;_ end of cons *MIP_LAYER_LST* ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (if (= (vla-get-freeze item) :vlax-true) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))) ) ;_ end of vlax-for ) ;_ end of defun (defun ChangeAllObjectsColor (Doc Color ) (vlax-for Blk (vla-get-Blocks Doc) (if (= (vla-get-IsXref Blk) :vlax-false) (vlax-for Obj Blk (if (vlax-property-available-p Obj 'Color) (vla-put-Color Obj Color) ) ) ) ) ) (defun C:COLORX ( / doc col) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (mip:layer-status-save) (if (setq col (acad_colordlg 7 t)) (ChangeAllObjectsColor doc col);_ col — color number ) (mip:layer-status-restore) (vla-endundomark doc) (princ) ) (princ "\nType ColorX in command line")

    COLORX đó thôi.

     

    Thử cái này, chưa test hết các trường hợp. 

    ;;;Code by Lee Mac, Copyright
;;;Modified by Bee
(defun c:All2 nil
    (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (vlax-for obj block
            (if (wcmatch (vla-get-objectname obj) "AcDb*Dimension,AcDbAttributeDefinition")
                (if (wcmatch (vla-get-objectname obj) "AcDbAttributeDefinition")
                  (progn
                    (vl-catch-all-apply 'vla-put-color (list obj 5))
                    (vl-cmdf "_.AttSync" "Name" (vla-get-name block))
                    )
                  (foreach prop '(Color DimensionLineColor ExtensionLineColor TextColor)
                    (vl-catch-all-apply 'vlax-put-property (list obj prop 5))
                    )
                  )
                (vl-catch-all-apply 'vla-put-color (list obj 5));
            )
        )
    )
    (princ)
)

     

×