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

[Đã xong] Lisp vẽ Text/Dtext kiểu rút gọn

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

Chúc mừng năm mới Giáp Ngọ 2014 !

Nhân dịp năm mới Giáp Ngọ 2014, xin gởi các bạn lời chúc Tết cùng món quà Xuân là lisp vẽ Text/Dtext theo kiểu rút gọn.

Lisp này không thay thế lệnh gốc, nhưng nó sử dụng gọn hơn nếu như nhu cầu của các bạn chỉ là đơn giản như lisp, đặc biệt là tính mặc định và hạn chế phải enter.

Đáng lý lisp này sẽ được post ở link dưới để thuận tiện, nhưng vì không sửa được tiêu đề nên đành mở topic mới.

http://www.cadviet.com/forum/topic/92515-da-xong-lisp-ve-circle-ellipse-rectang-kieu-rut-gon/

Cú pháp: sau khi load file sẽ có chỉ dẫn.

 

;; Lenh Dtext rut gon.
;; Doan Van Ha - CadViet.com - 01/01/2014
;----- Draw Dtext voi cac gia tri mac dinh cua lan truoc, chi can pick diem lien tuc va nhap text.
(defun Get_Jus()
 (initget "A F C M L R TL TC TR ML MC MR BL BC BR")
 (setq jus (getkword "\Enter an option [Align/Fit/Center/Middle/Left/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: ")))
(defun Get_Sty()
 (princ "\nList Text Styles:")
 (mapcar '(lambda(sty fon hei wid ang) (princ (strcat "\n\n" "Style name: " sty " ; " "Font files: " fon " ; " "Height: " (rtos hei 2) " ; " "Width factor: " (rtos wid 2) " ; " "Obliquing angle: " (angtos oang)))) lst1 lst2 lst3 lst4 lst5)
 (princ) (princ)
 (textpage)
 (while (not (vl-position (strcase (if (= "" (setq sty (getstring (strcat "\nEnter style name <" stycur ">: ")))) (setq sty stycur) sty)) (mapcar 'strcase lst1))))
 (graphscr)
 (princ (strcat "\nCurrent text style: " sty " ; " "Text height: " (rtos (setq hei (nth (vl-position (strcase sty) (mapcar 'strcase lst1)) lst3)) 2))))
(defun MakeText1 (pt jus sty hei ang txt / lst)
 (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 1 txt) (cons 40 hei) (cons 50 ang) (cons 7 sty)))
 (cond 
  ((= jus "L") (setq lst (append lst (list (cons 72 0) (cons 73 0)))))
  ((= jus "C") (setq lst (append lst (list (cons 72 1) (cons 11 pt)))))
  ((= jus "R") (setq lst (append lst (list (cons 72 2) (cons 11 pt)))))
  ((= jus "M") (setq lst (append lst (list (cons 72 4) (cons 11 pt)))))
  ((= jus "TL") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 3)))))
  ((= jus "TC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 3)))))
  ((= jus "TR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 3)))))
  ((= jus "ML") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 2)))))
  ((= jus "MC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 2)))))
  ((= jus "MR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 2)))))
  ((= jus "BL") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 1)))))
  ((= jus "BC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 1)))))
  ((= jus "BR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 1))))))
 (entmake lst)
 (vl-cmdf "ddedit" (entlast) ""))
(defun MakeText2 (ps pe jus sty hei ang txt / lst)
 (setq lst (list '(0 . "TEXT") (cons 10 ps) (cons 11 pe) (cons 1 txt) (cons 40 hei) (cons 50 ang) (cons 7 sty)))
 (cond 
  ((= jus "A") (setq lst (append lst (list (cons 72 3) (cons 73 0)))))
  ((= jus "F") (setq lst (append lst (list (cons 72 5) (cons 73 0))))))
 (entmake lst)
 (vl-cmdf "ddedit" (entlast) ""))
;; Main 
(vl-load-com)
(if (null text_reactor) (setq text_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . Text_HA)))))
(defun Text_HA (a b / lst1 lst2 lst3 lst4 lst5 vla stycur vt fon wid oang op)
 (setq vla (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))))
 (vlax-map-collection vla '(lambda(x) (setq lst1 (cons (vla-get-Name x) lst1))))
 (vlax-map-collection vla '(lambda(x) (setq lst2 (cons (vla-get-FontFile x) lst2))))
 (vlax-map-collection vla '(lambda(x) (setq lst3 (cons (vla-get-Height x) lst3))))
 (vlax-map-collection vla '(lambda(x) (setq lst4 (cons (vla-get-Width x) lst4))))
 (vlax-map-collection vla '(lambda(x) (setq lst5 (cons (vla-get-ObliqueAngle x) lst5))))
 (setq stycur (getvar "textstyle") vt (vl-position stycur lst1) fon (nth vt lst2) hei (nth vt lst3) wid (nth vt lst4) oang (nth vt lst5))
 (if (= (strcase (nth 0 b)) "DT1")
  (progn
   (princ (strcat "\nCurrent text style: \"" stycur  "\"  Text height: " (rtos (nth (vl-position stycur lst1) lst3) 2)))
   (initget "J S")
   (setq op (getpoint "\nSpecify point of text or [Justify/Style]: "))
   (cond
    ((= op "J") (Get_Jus))
    ((= op "S") (Get_Sty))
    ((= (type op) 'LIST) (setq jus "L" pt op daco T))
    (T (setq pt nil)))
   (if (/= (setq hei1 hei) 0)
    (setq hei (getreal (strcat "\nSpecify height <" (rtos hei1 2) ">: "))))
   (setq ang (getangle "\nSpecify rotation angle of text <0>: "))
   (if (not jus) (setq jus "L"))
   (if (not sty) (setq sty stycur))
   (if (not hei) (setq hei hei1))
   (if (not ang) (setq ang 0))
   (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "DT2 ")))
 (princ))
(defun DT2()
 (setvar "textstyle" sty)
 (while
  (cond
   ((or (= jus "A") (= jus "F"))
    (if (setq ps (getpoint "\nSpecify first endpoint of text baseline: "))
(if (setq pe (getpoint ps "\nSpecify second endpoint of text baseline: "))
      (MakeText2 ps pe jus sty hei ang " "))))
   ((= jus "L")
    (if daco
     (progn
 (setq daco nil)
      (MakeText1 pt jus sty hei ang " "))
     (if (setq pt (getpoint "\nSpecify point of text: "))
      (MakeText1 pt jus sty hei ang " "))))
   (T
    (if (setq pt (getpoint "\nSpecify point of text: "))
     (MakeText1 pt jus sty hei ang " "))))))
(vlax-add-cmd "DT2" 'DT2)
(princ "\nTrong 1 phi\U+00EAn l\U+00E0m vi\U+1EC7c:")
(princ "\n L\U+1EA7n 1: d\U+00F9ng l\U+1EC7nh DT1 \U+0111\U+1EC3 c\U+00E0i \U+0111\U+1EB7t m\U+1EB7c \U+0111\U+1ECBnh v\U+00E0 ghi Text.")
(princ "\n L\U+1EA7n n: d\U+00F9ng l\U+1EC7nh DT2 ho\U+1EB7c Enter \U+0111\U+1EC3 ghi Text theo m\U+1EB7c \U+0111\U+1ECBnh.")
  • Vote tăng 2

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

 

Chúc mừng năm mới Giáp Ngọ 2014 !

Nhân dịp năm mới Giáp Ngọ 2014, xin gởi các bạn lời chúc Tết cùng món quà Xuân là lisp vẽ Text/Dtext theo kiểu rút gọn.

Lisp này không thay thế lệnh gốc, nhưng nó sử dụng gọn hơn nếu như nhu cầu của các bạn chỉ là đơn giản như lisp, đặc biệt là tính mặc định và hạn chế phải enter.

Đáng lý lisp này sẽ được post ở link dưới để thuận tiện, nhưng vì không sửa được tiêu đề nên đành mở topic mới.

http://www.cadviet.com/forum/topic/92515-da-xong-lisp-ve-circle-ellipse-rectang-kieu-rut-gon/

Cú pháp: sau khi load file sẽ có chỉ dẫn.

;; Lenh Dtext rut gon.
;; Doan Van Ha - CadViet.com - 01/01/2014
;----- Draw Dtext voi cac gia tri mac dinh cua lan truoc, chi can pick diem lien tuc va nhap text.
(defun Get_Jus()
 (initget "A F C M L R TL TC TR ML MC MR BL BC BR")
 (setq jus (getkword "\Enter an option [Align/Fit/Center/Middle/Left/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]: ")))
(defun Get_Sty()
 (princ "\nList Text Styles:")
 (mapcar '(lambda(sty fon hei wid ang) (princ (strcat "\n\n" "Style name: " sty " ; " "Font files: " fon " ; " "Height: " (rtos hei 2) " ; " "Width factor: " (rtos wid 2) " ; " "Obliquing angle: " (angtos oang)))) lst1 lst2 lst3 lst4 lst5)
 (princ) (princ)
 (textpage)
 (while (not (vl-position (strcase (if (= "" (setq sty (getstring (strcat "\nEnter style name <" stycur ">: ")))) (setq sty stycur) sty)) (mapcar 'strcase lst1))))
 (graphscr)
 (princ (strcat "\nCurrent text style: " sty " ; " "Text height: " (rtos (setq hei (nth (vl-position (strcase sty) (mapcar 'strcase lst1)) lst3)) 2))))
(defun MakeText1 (pt jus sty hei ang txt / lst)
 (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 1 txt) (cons 40 hei) (cons 50 ang) (cons 7 sty)))
 (cond 
  ((= jus "L") (setq lst (append lst (list (cons 72 0) (cons 73 0)))))
  ((= jus "C") (setq lst (append lst (list (cons 72 1) (cons 11 pt)))))
  ((= jus "R") (setq lst (append lst (list (cons 72 2) (cons 11 pt)))))
  ((= jus "M") (setq lst (append lst (list (cons 72 4) (cons 11 pt)))))
  ((= jus "TL") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 3)))))
  ((= jus "TC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 3)))))
  ((= jus "TR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 3)))))
  ((= jus "ML") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 2)))))
  ((= jus "MC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 2)))))
  ((= jus "MR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 2)))))
  ((= jus "BL") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 1)))))
  ((= jus "BC") (setq lst (append lst (list (cons 72 1) (cons 11 pt) (cons 73 1)))))
  ((= jus "BR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 1))))))
 (entmake lst)
 (vl-cmdf "ddedit" (entlast) ""))
(defun MakeText2 (ps pe jus sty hei ang txt / lst)
 (setq lst (list '(0 . "TEXT") (cons 10 ps) (cons 11 pe) (cons 1 txt) (cons 40 hei) (cons 50 ang) (cons 7 sty)))
 (cond 
  ((= jus "A") (setq lst (append lst (list (cons 72 3) (cons 73 0)))))
  ((= jus "F") (setq lst (append lst (list (cons 72 5) (cons 73 0))))))
 (entmake lst)
 (vl-cmdf "ddedit" (entlast) ""))
;; Main 
(vl-load-com)
(if (null text_reactor) (setq text_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . Text_HA)))))
(defun Text_HA (a b / lst1 lst2 lst3 lst4 lst5 vla stycur vt fon wid oang op)
 (setq vla (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))))
 (vlax-map-collection vla '(lambda(x) (setq lst1 (cons (vla-get-Name x) lst1))))
 (vlax-map-collection vla '(lambda(x) (setq lst2 (cons (vla-get-FontFile x) lst2))))
 (vlax-map-collection vla '(lambda(x) (setq lst3 (cons (vla-get-Height x) lst3))))
 (vlax-map-collection vla '(lambda(x) (setq lst4 (cons (vla-get-Width x) lst4))))
 (vlax-map-collection vla '(lambda(x) (setq lst5 (cons (vla-get-ObliqueAngle x) lst5))))
 (setq stycur (getvar "textstyle") vt (vl-position stycur lst1) fon (nth vt lst2) hei (nth vt lst3) wid (nth vt lst4) oang (nth vt lst5))
 (if (= (strcase (nth 0 b)) "DT1")
  (progn
   (princ (strcat "\nCurrent text style: \"" stycur  "\"  Text height: " (rtos (nth (vl-position stycur lst1) lst3) 2)))
   (initget "J S")
   (setq op (getpoint "\nSpecify point of text or [Justify/Style]: "))
   (cond
    ((= op "J") (Get_Jus))
    ((= op "S") (Get_Sty))
    ((= (type op) 'LIST) (setq jus "L" pt op daco T))
    (T (setq pt nil)))
   (if (/= (setq hei1 hei) 0)
    (setq hei (getreal (strcat "\nSpecify height <" (rtos hei1 2) ">: "))))
   (setq ang (getangle "\nSpecify rotation angle of text <0>: "))
   (if (not jus) (setq jus "L"))
   (if (not sty) (setq sty stycur))
   (if (not hei) (setq hei hei1))
   (if (not ang) (setq ang 0))
   (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "DT2 ")))
 (princ))
(defun DT2()
 (setvar "textstyle" sty)
 (while
  (cond
   ((or (= jus "A") (= jus "F"))
    (if (setq ps (getpoint "\nSpecify first endpoint of text baseline: "))
(if (setq pe (getpoint ps "\nSpecify second endpoint of text baseline: "))
      (MakeText2 ps pe jus sty hei ang " "))))
   ((= jus "L")
    (if daco
     (progn
 (setq daco nil)
      (MakeText1 pt jus sty hei ang " "))
     (if (setq pt (getpoint "\nSpecify point of text: "))
      (MakeText1 pt jus sty hei ang " "))))
   (T
    (if (setq pt (getpoint "\nSpecify point of text: "))
     (MakeText1 pt jus sty hei ang " "))))))
(vlax-add-cmd "DT2" 'DT2)
(princ "\nTrong 1 phi\U+00EAn l\U+00E0m vi\U+1EC7c:")
(princ "\n L\U+1EA7n 1: d\U+00F9ng l\U+1EC7nh DT1 \U+0111\U+1EC3 c\U+00E0i \U+0111\U+1EB7t m\U+1EB7c \U+0111\U+1ECBnh v\U+00E0 ghi Text.")
(princ "\n L\U+1EA7n n: d\U+00F9ng l\U+1EC7nh DT2 ho\U+1EB7c Enter \U+0111\U+1EC3 ghi Text theo m\U+1EB7c \U+0111\U+1ECBnh.")

Lệnh gọi lisp là như thế nào bác #DoanVanHa ơi.

  • Vote giảm 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

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  

×