Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
19 replies to this topic

#1 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 28 September 2015 - 11:44 AM

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


  • -1

#2 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 29 September 2015 - 02:12 PM

Mình có 1 li sp về sửa chữa text trong block , các bạn xem nhé

Yêu cầu sửa text của mình là sửa Hight và width cũng tương tự mà các bạn làm giúp minh nhé

Thanks

http://www.cadviet.c...a_chua_eb_2.lsp


  • 0

#3 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 29 September 2015 - 04:26 PM

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)
)

  • 1

#4 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 29 September 2015 - 05:46 PM

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


  • 0

#5 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 29 September 2015 - 06:11 PM

không được


  • 1

#6 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 29 September 2015 - 07:50 PM

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))


  • 1

#7 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 29 September 2015 - 09:43 PM

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


  • 0

#8 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 30 September 2015 - 08:46 PM

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


  • -1

#9 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 30 September 2015 - 09:08 PM

http://www.cadviet.c...317_2972012.dwg

File này nhè bạn xem hộ mình cái


  • 0

#10 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 30 September 2015 - 09:18 PM

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.


  • 1

#11 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 30 September 2015 - 10:47 PM

Mình thử rùi vẫn bị treo máy bạn ah11317_anh.png


  • 0

#12 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 30 September 2015 - 10:53 PM

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é!


  • 1

#13 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 30 September 2015 - 11:12 PM

Audit rui bạn ơi, nhưng vẫn bị lỗi :(


  • 0

#14 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 30 September 2015 - 11:27 PM

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ả.


  • 1

#15 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 30 September 2015 - 11:58 PM

Vẫn thế bạn ah, mình thử mấy cái rùi, cái được cái không

Bạn xem giúp là do cad hay li sp giúp mình nhé


  • 0

#16 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 314 (khá)

Đã gửi 01 October 2015 - 12:45 AM

Tìm ra lỗi rồi! bạn thay dòng này nhé: (set_tile "sty" (rtos possty))  

Bởi:

(set_tile "sty" (itoa possty))​


  • 1

#17 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 01 October 2015 - 08:18 AM

Thanks bạn, mình đã check mấy bản vẽ thấy ổn rùi bạn ah

Thanks


  • 0

#18 phamhung12

phamhung12

    biết vẽ ellipse

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

Đã gửi 11 October 2015 - 02:14 PM

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 !


  • 0

#19 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 12 October 2015 - 10:08 AM

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))


  • 3

#20 phamhung12

phamhung12

    biết vẽ ellipse

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

Đã gửi 12 October 2015 - 03:38 PM

Đúng là tuyệt vời! Thanks!


  • 0