Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
hung1608

Lisp Thay Đổi Height Và Width Factor Của Text Attribute Trong Block

Bởi hung1608 , trong AutoLisp

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

hung1608    8

hung1608
Đã đăng

Khung tên bản vẽ của mình là block att, trong đó có nhiều text ATT.

Mình muốn nhờ các bạn viết giúp mình 1 lisp có thể thay đổi được chiều cao và độ rộng của text ATT mà không phải kích vào trong block bởi block nhiều text chọn rùi chỉnh sửa rất mất công

Thanks

  • 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

tien2005    242

tien2005
Đã đăng

bạn thử xem

(defun c:CHW (/ ss h sc)
  (if (and
	(SETQ ss (ssget '((0 . "insert") (66 . 1))))
	(setq h (getreal "\nChieu cao chu: "))
	(setq sc (getreal "\nDo rong chu: "))
      )
    (progn
      (setq
	ss (mapcar 'vlax-ename->vla-object
		   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	   )
      )
      (mapcar '(lambda (Obj)
		 (mapcar '(lambda (x)
			    (vla-put-height x h)
			    (vla-put-scalefactor x sc)
			  )
			 (vlax-invoke Obj 'GetAttributes)
		 )
	       )
	      ss
      )
    )
  )
  (princ)
)
  • 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

hung1608    8

hung1608
Đã đăng

Bạn ơi chỉnh cho mình 1 chút nữa được không

Lisp của bạn hoạt động rùi, nhưng nó tăng tất cả các text Att trong block , bạn có thẻ làm cho lisp điều chỉnh các text riêng biệt được không, và khi chọn text thì mình biết được chiều cao và độ rộng của text hiện là bao nhiêu được không bạn để khi điều chỉnh dễ dàng hơn

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

quocmanh04tt    635

quocmanh04tt
Đã đăng

Hy vọng là được (Khuyến mại thêm Textstyle): :D​

(defun c:eb (/ get-gc put-gc getvalue *error* att curcmd dcledittext dcl_id editext file_dcl hei oldhei oldval oldwid str wid dialog taolist
lststy possty sty)
(setq *error* (defun my-err (msg)
(cond ((= msg "function cancelled") (princ "\t\tuser abort"))
(t (progn (princ msg) (princ))))
(setq *error* nil)
(princ)))
(defun get-gc (group entity) (cdr (assoc group (entget entity))))
(defun put-gc (value group entity / properties)
(setq properties (entget entity))
(setq properties (subst (cons group value) (assoc group properties) properties))
(entmod properties))
(defun getvalue ()
(setq str (get_tile "text")
hei (atof (get_tile "hei"))
wid (atof (get_tile "wid"))
sty (atoi (get_tile "sty"))))
(defun taolist (kieu / kieu nl lkq)
(setq lkq '())
(setq nl (tblnext kieu t))
(while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)))
lkq)
(vl-load-com)
(setq dcledittext (list
"edit: dialog {label = \"CHANGE TEXT PROPERTIES\";initial_focus = \"text\";"
":edit_box {label = \"String:\"; allow_accept = true; edit_width = 45; key = \"text\";}" ": row {"
":edit_box {label = \"Height:\"; allow_accept = true; edit_width = 8; key = \"hei\";}"
":edit_box {label = \"Width:\"; allow_accept = true; edit_width = 8; key = \"wid\";}"
":popup_list {allow_accept = true; edit_width = 12; key = \"sty\";}" "}" "spacer_1;" "ok_cancel;}"))
(setq curcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (/= (setq att (car (nentselp "\nselect attribute for edit: "))) nil)
(if (or (= (get-gc 0 att) "ATTRIB") (= (get-gc 0 att) "TEXT"))
(progn (setq oldval (get-gc 1 att)
oldhei (rtos (get-gc 40 att) 2 (getvar 'LUPREC))
oldwid (rtos (get-gc 41 att) 2 2)
oldsty (get-gc 7 att)
lststy (taolist "STYLE")
possty (vl-position oldsty lststy))
(setq editext.dcl (vl-filename-mktemp "edittext.dcl")
file_dcl (open editext.dcl "w"))
(foreach ll dcledittext (write-line ll file_dcl))
(close file_dcl)
(if (> 0 (setq dcl_id (load_dialog editext.dcl)))
(progn (alert "not found file edittext.dcl") (exit)))
(if (not (new_dialog "edit" dcl_id))
(progn (alert "not found edit dialog") (exit)))
(set_tile "text" oldval)
(set_tile "hei" oldhei)
(set_tile "wid" oldwid)
(set_tile "sty" (rtos possty))
(start_list "sty" 3)
(mapcar 'add_list lststy)
(end_list)
(action_tile "accept" "(getvalue)(setq dialog 1)(done_dialog)")
(action_tile "cancel" "(setq dialog nil)")
(start_dialog)
(unload_dialog dcl_id)
(if (eq dialog 1)
(progn (put-gc str 1 att) (put-gc hei 40 att) (put-gc wid 41 att) (put-gc (nth sty lststy) 7 att))))
(princ "select attrib/text")))
(if editext.dcl
(vl-file-delete editext.dcl))
(setvar "cmdecho" curcmd)
(setq *error* nil)
(princ))
  • 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

hung1608    8

hung1608
Đã đăng

Hy vọng là được (Khuyến mại thêm Textstyle): :D​

(defun c:eb (/ get-gc put-gc getvalue *error* att curcmd dcledittext dcl_id editext file_dcl hei oldhei oldval oldwid str wid dialog taolist

lststy possty sty)

(setq *error* (defun my-err (msg)

(cond ((= msg "function cancelled") (princ "\t\tuser abort"))

(t (progn (princ msg) (princ))))

(setq *error* nil)

(princ)))

(defun get-gc (group entity) (cdr (assoc group (entget entity))))

(defun put-gc (value group entity / properties)

(setq properties (entget entity))

(setq properties (subst (cons group value) (assoc group properties) properties))

(entmod properties))

(defun getvalue ()

(setq str (get_tile "text")

hei (atof (get_tile "hei"))

wid (atof (get_tile "wid"))

sty (atoi (get_tile "sty"))))

(defun taolist (kieu / kieu nl lkq)

(setq lkq '())

(setq nl (tblnext kieu t))

(while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)))

lkq)

(vl-load-com)

(setq dcledittext (list

"edit: dialog {label = \"CHANGE TEXT PROPERTIES\";initial_focus = \"text\";"

":edit_box {label = \"String:\"; allow_accept = true; edit_width = 45; key = \"text\";}" ": row {"

":edit_box {label = \"Height:\"; allow_accept = true; edit_width = 8; key = \"hei\";}"

":edit_box {label = \"Width:\"; allow_accept = true; edit_width = 8; key = \"wid\";}"

":popup_list {allow_accept = true; edit_width = 12; key = \"sty\";}" "}" "spacer_1;" "ok_cancel;}"))

(setq curcmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(while (/= (setq att (car (nentselp "\nselect attribute for edit: "))) nil)

(if (or (= (get-gc 0 att) "ATTRIB") (= (get-gc 0 att) "TEXT"))

(progn (setq oldval (get-gc 1 att)

oldhei (rtos (get-gc 40 att) 2 (getvar 'LUPREC))

oldwid (rtos (get-gc 41 att) 2 2)

oldsty (get-gc 7 att)

lststy (taolist "STYLE")

possty (vl-position oldsty lststy))

(setq editext.dcl (vl-filename-mktemp "edittext.dcl")

file_dcl (open editext.dcl "w"))

(foreach ll dcledittext (write-line ll file_dcl))

(close file_dcl)

(if (> 0 (setq dcl_id (load_dialog editext.dcl)))

(progn (alert "not found file edittext.dcl") (exit)))

(if (not (new_dialog "edit" dcl_id))

(progn (alert "not found edit dialog") (exit)))

(set_tile "text" oldval)

(set_tile "hei" oldhei)

(set_tile "wid" oldwid)

(set_tile "sty" (rtos possty))

(start_list "sty" 3)

(mapcar 'add_list lststy)

(end_list)

(action_tile "accept" "(getvalue)(setq dialog 1)(done_dialog)")

(action_tile "cancel" "(setq dialog nil)")

(start_dialog)

(unload_dialog dcl_id)

(if (eq dialog 1)

(progn (put-gc str 1 att) (put-gc hei 40 att) (put-gc wid 41 att) (put-gc (nth sty lststy) 7 att))))

(princ "select attrib/text")))

(if editext.dcl

(vl-file-delete editext.dcl))

(setvar "cmdecho" curcmd)

(setq *error* nil)

(princ))

Tuyệt vời bạn ơi

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

hung1608    8

hung1608
Đã đăng

Bị lỗi bạn ơi, dung lần 1 được, lần 2 load lại không dung được, đơ luôn cả cad bạn ahf

Bạn check hộ xem tại sao giúp mình cá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

quocmanh04tt    635

quocmanh04tt
Đã đăng

Lạ nhỉ ...! Máy của mình không sao.

Bạn thử thế này nhé: Chỉ load mỗi lisp eb, không load bất kỳ 1 lisp nào khác xem có lỗi không, để mình có phương án kiểm tra.

  • 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

quocmanh04tt    635

quocmanh04tt
Đã đăng

Hình như file của bạn bị lỗi. Bạn thử dùng lệnh audit để sửa chữa bản vẽ xem.

Mình thử trên file của bạn cũng có lần bị như thế, sau khi audit thì không thấy nữa.

Thử xong báo với nhé!

  • 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

quocmanh04tt    635

quocmanh04tt
Đã đăng

Bạn thử: Audit xong, save, tắt cad, mở lại và thử xem. Máy của mình sau khi làm như vậy thì không thấy nữa.

Bạn thử trên 1 file cad khác xem sao. Mình xem lại lisp thì chưa thấy vấn đề gì cả.

  • 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

phamhung12    1

phamhung12
Đã đăng

Hy vọng là được (Khuyến mại thêm Textstyle): :D​

(defun c:eb (/ get-gc put-gc getvalue *error* att curcmd dcledittext dcl_id editext file_dcl hei oldhei oldval oldwid str wid dialog taolist

lststy possty sty)

(setq *error* (defun my-err (msg)

(cond ((= msg "function cancelled") (princ "\t\tuser abort"))

(t (progn (princ msg) (princ))))

(setq *error* nil)

(princ)))

(defun get-gc (group entity) (cdr (assoc group (entget entity))))

(defun put-gc (value group entity / properties)

(setq properties (entget entity))

(setq properties (subst (cons group value) (assoc group properties) properties))

(entmod properties))

(defun getvalue ()

(setq str (get_tile "text")

hei (atof (get_tile "hei"))

wid (atof (get_tile "wid"))

sty (atoi (get_tile "sty"))))

(defun taolist (kieu / kieu nl lkq)

(setq lkq '())

(setq nl (tblnext kieu t))

(while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)))

lkq)

(vl-load-com)

(setq dcledittext (list

"edit: dialog {label = \"CHANGE TEXT PROPERTIES\";initial_focus = \"text\";"

":edit_box {label = \"String:\"; allow_accept = true; edit_width = 45; key = \"text\";}" ": row {"

":edit_box {label = \"Height:\"; allow_accept = true; edit_width = 8; key = \"hei\";}"

":edit_box {label = \"Width:\"; allow_accept = true; edit_width = 8; key = \"wid\";}"

":popup_list {allow_accept = true; edit_width = 12; key = \"sty\";}" "}" "spacer_1;" "ok_cancel;}"))

(setq curcmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(while (/= (setq att (car (nentselp "\nselect attribute for edit: "))) nil)

(if (or (= (get-gc 0 att) "ATTRIB") (= (get-gc 0 att) "TEXT"))

(progn (setq oldval (get-gc 1 att)

oldhei (rtos (get-gc 40 att) 2 (getvar 'LUPREC))

oldwid (rtos (get-gc 41 att) 2 2)

oldsty (get-gc 7 att)

lststy (taolist "STYLE")

possty (vl-position oldsty lststy))

(setq editext.dcl (vl-filename-mktemp "edittext.dcl")

file_dcl (open editext.dcl "w"))

(foreach ll dcledittext (write-line ll file_dcl))

(close file_dcl)

(if (> 0 (setq dcl_id (load_dialog editext.dcl)))

(progn (alert "not found file edittext.dcl") (exit)))

(if (not (new_dialog "edit" dcl_id))

(progn (alert "not found edit dialog") (exit)))

(set_tile "text" oldval)

(set_tile "hei" oldhei)

(set_tile "wid" oldwid)

(set_tile "sty" (rtos possty))

(start_list "sty" 3)

(mapcar 'add_list lststy)

(end_list)

(action_tile "accept" "(getvalue)(setq dialog 1)(done_dialog)")

(action_tile "cancel" "(setq dialog nil)")

(start_dialog)

(unload_dialog dcl_id)

(if (eq dialog 1)

(progn (put-gc str 1 att) (put-gc hei 40 att) (put-gc wid 41 att) (put-gc (nth sty lststy) 7 att))))

(princ "select attrib/text")))

(if editext.dcl

(vl-file-delete editext.dcl))

(setvar "cmdecho" curcmd)

(setq *error* nil)

(princ))

Lisp này có thêm chức năng đổi màu nữa thì Tuyệt !

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

pphung183    428

pphung183
Đã đăng

Thêm màu mè là đây :D :

(defun c:eb (/ colimg get-gc put-gc getvalue *error* att curcmd dcledittext dcl_id editext file_dcl hei oldhei oldval oldwid str wid dialog taolist

lststy possty sty #color)

(setq *error* (defun my-err (msg)

(cond ((= msg "function cancelled") (princ "\t\tuser abort"))

(t (progn (princ msg) (princ))))

(setq *error* nil)

(princ)))

(defun colimg (k c)
(start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image) )

(defun get-gc (group entity) (cdr (assoc group (entget entity))))

(defun put-gc (value group entity / properties)

(setq properties (entget entity))

(setq properties (subst (cons group value) (assoc group properties) properties))

(entmod properties))

(defun getvalue ()

(setq str (get_tile "text")

hei (atof (get_tile "hei"))

wid (atof (get_tile "wid"))

sty (atoi (get_tile "sty"))))

(defun taolist (kieu / kieu nl lkq)

(setq lkq '())

(setq nl (tblnext kieu t))

(while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)))

lkq)

(vl-load-com)

(setq dcledittext (list

"edit: dialog {label = \"CHANGE TEXT PROPERTIES\";initial_focus = \"text\";"

":edit_box {label = \"String:\"; allow_accept = true; edit_width = 45; key = \"text\";}" ": row {"

":edit_box {label = \"Height:\"; allow_accept = true; edit_width = 8; key = \"hei\";}"

":edit_box {label = \"Width:\"; allow_accept = true; edit_width = 8; key = \"wid\";}"

":popup_list {allow_accept = true; edit_width = 12; key = \"sty\";}" "}" "spacer_1;"

" :row {" " : text {" " label = \"Ch\U+1ECDn Color cho Text :\"; alignment =left;" "}"
" : image_button {"
" key = \"color\"; alignment = centered; height = 1.7; width = 15.0; fixed_width = false;   fixed_height = true;" "}}"
 
"ok_cancel;}"))

(setq curcmd (getvar "cmdecho"))

(setvar "cmdecho" 0)

(while (/= (setq att (car (nentselp "\nselect attribute for edit: "))) nil)

(if (or (= (get-gc 0 att) "ATTRIB") (= (get-gc 0 att) "TEXT"))

(progn (setq oldval (get-gc 1 att)

oldhei (rtos (get-gc 40 att) 2 (getvar 'LUPREC))

oldwid (rtos (get-gc 41 att) 2 2)

oldsty (get-gc 7 att)

lststy (taolist "STYLE")

possty (vl-position oldsty lststy))

(setq editext.dcl (vl-filename-mktemp "edittext.dcl")

file_dcl (open editext.dcl "w"))

(foreach ll dcledittext (write-line ll file_dcl))

(close file_dcl)

(if (> 0 (setq dcl_id (load_dialog editext.dcl)))

(progn (alert "not found file edittext.dcl") (exit)))

(if (not (new_dialog "edit" dcl_id))

(progn (alert "not found edit dialog") (exit)))

(set_tile "text" oldval)

(set_tile "hei" oldhei)

(set_tile "wid" oldwid)

(set_tile "sty" (itoa possty))

(start_list "sty" 3)

(mapcar 'add_list lststy)

(end_list)

(setq #color (vla-get-color (vlax-ename->vla-object att))) (colimg "color" #color)

(action_tile "color" "(if (setq #color (acad_colordlg #color)) (colimg \"color\" #color))")

(action_tile "accept" "(getvalue) (vla-put-color (vlax-ename->vla-object att) #color)(setq dialog 1)(done_dialog)")

(action_tile "cancel" "(setq dialog nil)")

(start_dialog)

(unload_dialog dcl_id)

(if (eq dialog 1)

(progn (put-gc str 1 att) (put-gc hei 40 att) (put-gc wid 41 att) (put-gc (nth sty lststy) 7 att))))

(princ "select attrib/text")))

(if editext.dcl

(vl-file-delete editext.dcl))

(setvar "cmdecho" curcmd)

(setq *error* nil)

(princ))
  • 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

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×