Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
3 replies to this topic

#1 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 30 January 2014 - 08:28 PM

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.c...g-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.")

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 412 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 31 January 2014 - 10:35 AM

Sang năm mới lại có lisp hay để dùng :), thx bác Hà nhiều!
  • 0

#3 nhunha_pro279

nhunha_pro279

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: -4 (bình thường)

Đã gửi 06 December 2016 - 09:16 PM

 

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.c...g-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.


  • -1

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 06 December 2016 - 09:37 PM

Load lisp xong, bấm F2 sẽ lòi ra lệnh


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.