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

lisp đổi font của text style siêu nhanh !

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

Bản full option gửi anh em nhé. 

Có sử dụng thêm List Box with Filter của cụ lee.

http://www.lee-mac.com/filtlistbox.html

anh em dùng cái này nhé

(defun c:cfst (/ doc sty font lst system)
  (setq 
    doc (vla-get-activedocument (vlax-get-acad-object)) 
    sty (vla-get-textstyles doc)
    system (strcat (getenv "systemroot") "\\Fonts")
    font (vl-directory-files (vl-string-translate "/" "\\" system) nil 1)
    font (vl-remove-if-not '(lambda (x) (vl-string-search "TTF" (strcase x))) font)
  )
  (vlax-for s sty (setq lst (cons (vla-get-name s) lst)))
  (if (and   
        (setq lst (LM:filtlistbox "Select Style" lst t))
        (setq font (car (LM:filtlistbox "Select Font" font nil)))
        (setq font (strcat system "\\" font))
      )
    (foreach item lst
      (vla-put-fontfile (vla-item sty item ) font)
    )
  )
  (vla-regen doc acActiveViewport)
  (princ)
)

(defun LM:filtlistbox ( msg lst mtp / _addlist dch dcl des rtn sel tmp )
  (defun _addlist ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
  )
  (if (and
        (setq dcl (vl-filename-mktemp nil nil ".dcl"))
        (setq des (open dcl "w"))
        (write-line (strcat
          "filtlistbox : dialog { label = \"" msg "\"; spacer;"
          ": list_box { key = \"lst\"; width = 50; fixed_width = true; height = 15; fixed_height = true; allow_accept = true; "
          "multiple_select = " (if mtp "true" "false") "; }"
          ": edit_box { key = \"flt\"; width = 50; fixed_width = true; label = \"Filter:\"; }"
          "spacer; ok_cancel; }") des)
        (not (close des))
        (< 0 (setq dch (load_dialog dcl)))
        (new_dialog "filtlistbox" dch)
      )
    (progn
      (_addlist "lst" (setq tmp lst))
      (set_tile "lst" (setq rtn "0"))
      (set_tile "flt" "*")
      (action_tile "lst" "(setq rtn $value)")
      (action_tile "flt" (vl-prin1-to-string '(progn
        (setq 
          flt (strcat "*" (strcase $value) "*")
          sel (mapcar '(lambda ( n ) (nth n tmp)) (read (strcat "(" rtn ")")))
        )
        (_addlist "lst" (setq tmp (vl-remove-if-not '(lambda ( x ) (wcmatch (strcase x) flt)) lst)))
        (set_tile "lst" (setq rtn (vl-string-trim "()"
          (vl-princ-to-string (cond ((vl-sort (vl-remove nil (mapcar '(lambda ( x ) (vl-position x tmp)) sel)) '<))('(0)))))))
      )))
      (setq rtn (if (= 1 (start_dialog)) (mapcar '(lambda ( x ) (nth x tmp)) (read (strcat "(" rtn ")")))))
    )
  )
  (if (< 0 dch) (setq dch (unload_dialog dch)))
  (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
  rtn
)

 

  • Like 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
Vào lúc 9/3/2023 tại 08:58, tannguyen291 đã nói:

Bác cứ đùa em. Bác viết lisp lão làng rồi mà.

cái này do đường dẫn không có font em_khong_co.ttf. 

Hoặc OS của bác không cài tại ổ C. Phải chỉnh lại 1 chút :))


Ý mình là lúc code các coder cứ chịu khó catch error đi thì sau này tay lên nhanh hơn. Nhiều lúc thấy nó có thể lỗi mà lười lên ... chẹp. 

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

×