Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
hung1608

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

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

hung1608    5

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    97

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    5

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    385

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    5

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    5

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    385

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    385

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    385

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

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    425

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  

×