Chuyển đến nội dung
Diễn đàn CADViet
Học AutoCAD Online cùng CADViet
Đăng nhập để thực hiện theo  
hdg2318

Lisp đổi màu text sau khi sửa

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

Mình down  về được rồi, tuy nhiên ở phần chọn dim nhưng chưa sữa dim vẫn đổi màu. Cảm ơn bạn Tue_NV nhiều lắm nha! Dù up lên nhiều lần, nhưng diễn dàn bị lỗi không down  về được nhưng bạn vẫn nhiệt tình chia sẽ cho anh,em. Cuối cùng thì mình cũng down về được rồi, lisp rất hữu ích cho mình trong công việc. Chúc bạn được nhiều sức khoẻ và thành công.

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

 

Mình down  về được rồi, tuy nhiên ở phần chọn dim nhưng chưa sữa dim vẫn đổi màu. Cảm ơn bạn Tue_NV nhiều lắm nha! Dù up lên nhiều lần, nhưng diễn dàn bị lỗi không down  về được nhưng bạn vẫn nhiệt tình chia sẽ cho anh,em. Cuối cùng thì mình cũng down về được rồi, lisp rất hữu ích cho mình trong công việc. Chúc bạn được nhiều sức khoẻ và thành công.

 

 

Có nghĩa là bạn muốn thao tác với dim cũng giống như thao tác với TexT?

Vì mình nghĩ Dim nào bạn cũng đổi nên mới viết thế! ^_^

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

Ok bạn! Vì có những dim mình không định sữa nhưng khi mình lỡ tay chạm vào thì nó vẫn đổi màu. 

Vậy bạn dùng lisp này:

(defun c:CTE (/ mausac mouse cont contt ent)
(vl-load-com)
(setq mausac "1") ; thay doi mau o day
(setq mouse nil)
(prompt "\n Chon doi tuong :")
(while (/= (car mouse) 2)
(setq mouse (grread 0 15 2))
(if (= (car mouse) 3)
(if (and (setq ent (nentselp (cadr mouse)))
         (or (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT")
          (eq (type (last ent)) 'ENAME)
)
     )
   (progn
(if (and (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT") (null (eq (type (car (last ent))) 'ENAME)))
   (progn (setq cont (cdr(assoc 1 (entget (setq ent (car ent)))))) (command ".ddedit" ent ""))
   (progn (setq cont (vlax-get (vlax-ename->vla-object (setq ent (car (last ent)))) 'TextOverride)) (command ".ddedit" ent ""))
)
(princ "\n doi tuong duoc pick chon/ENTER ke ket thuc chon")
 
(if (wcmatch (cdr(assoc 0 (entget ent))) "*TEXT")
      (if (/= (cdr(assoc 1 (entget ent))) cont)
       (command ".chprop" ent "" "c" mausac "")
      )
)
(if (eq (type ent) 'ENAME)
 (if (= (cdr(assoc 0 (entget ent))) "DIMENSION")
   (if (/= (vlax-get (vlax-ename->vla-object ent) 'TextOverride) cont)
    ;(command ".ddedit" ent "" ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
(command ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
   )
)
(princ "\nChon doi tuong")
)
)
)
)
(princ)
)

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

ThankS bạn Tue_NV nhiều nha! Nhưng bây giờ thì chỉ sửa dim được thôi, còn text thì không đổi màu được nữa. 

 

Sorry! Bạn thay dùm mình đoạn code

(if (and (wcmatch (cdr(assoc 0 (entget ent))) "*TEXT") (null (eq (type ent) 'ENAME)))

  (if (/= (cdr(assoc 1 (entget ent))) cont)

    (command ".chprop" ent "" "c" mausac "")

)

)

Bằng đoạn :

(if (wcmatch (cdr(assoc 0 (entget ent))) "*TEXT") 

     (if (/= (cdr(assoc 1 (entget ent))) cont)

      (command ".chprop" ent "" "c" mausac "")

)

)

  • 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

Ok bạn! Lisp này ứng dụng rất nhiều cho công việc của mình. Bây giờ mình dùng được rồi. Bạn là người rất nhiệt tình. Thanks bạn Tue_NV nhiều lắm nha! 

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

;; Mark EDited texts,mtexs,attribs,dimensions...

(defun c:EDM (/ ent enx s str _sel LM:editbox LM:startundo LM:endundo
LM:acdoc *error*
)

;; Edit Box - Lee Mac
;; Displays a DCL Edit Box to obtain a string from the user
;; str - [str] Initial value to display ("" for none)
;; Returns: [str] Edit box contents if user pressed OK, else nil

(defun LM:editbox (str / han)
(and (< 0 (setq han (load_dialog "acad")))
(new_dialog "acad_txtedit" han)
(set_tile "text_edit" str)
(action_tile "text_edit" "(setq str $value)")
(if (zerop (start_dialog))
(setq str nil)
)
)
(if (< 0 han)
(unload_dialog han)
)
str
)

(defun *error* (msg)
(LM:endundo (LM:acdoc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo (doc)
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo (doc)
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun
'LM:acdoc
'nil
(vla-get-activedocument (vlax-get-acad-object))
)
)
(LM:acdoc)
)
;; Select Text/Mtext/Attrib/Dimensiontext only
(defun _sel (/ ent str)
(while
(progn
(setvar 'errno 0)
(setq ent (nentsel "\nSelect Text/Mtext/Attrib/Dimension..."))
(cond
((= 7 (getvar 'errno)) (princ "\nMissed, try again."))
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (setq enx (entget (car ent)))))
"TEXT,MTEXT,ATTRIB"
)
(progn
(cond
((= 2 (length ent))
(setq ent (vlax-ename->vla-object (car ent)))
nil
)
((and
(= 4 (length ent))
(= "DIMENSION"
(cdr
(assoc 0 (entget (setq ent (car (last ent)))))
)
)
)
(setq ent (vlax-ename->vla-object ent))
nil
)
(t)
)
)
(princ "\nInvalid object selected.")
)
)
)
)
)
ent
)
;; ===============================================================;;
(LM:startundo (LM:acdoc))
(alert "Please Enter the Color code: \n(ex: 1=Red; 2=Yellow...)")
(if (or (setq cl (rem (getint) 256))
(setq cl 1)
)
(while (setq ent (_sel))
(if (and (setq str (LM:editbox (setq s (cdr (assoc 1 enx)))))
(/= str s)
)
(progn
(if (wcmatch (vla-get-objectname ent) "AcDb*Dimension")
(progn
(vlax-put ent 'TextOverride str)
(vlax-put ent 'textcolor cl)
)
(progn
(vlax-put ent 'textstring str)
(vlax-put ent 'color cl)
)
)
)
(princ (strcat "\nThe Text object unchanged!!!"
"\nPlease try again!!!"
)
)
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;

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

 

Vậy bạn dùng lisp này:

(defun c:CTE (/ mausac mouse cont contt ent)
(vl-load-com)
(setq mausac "1") ; thay doi mau o day
(setq mouse nil)
(prompt "\n Chon doi tuong :")
(while (/= (car mouse) 2)
(setq mouse (grread 0 15 2))
(if (= (car mouse) 3)
(if (and (setq ent (nentselp (cadr mouse)))
         (or (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT")
          (eq (type (last ent)) 'ENAME)
)
     )
   (progn
(if (and (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT") (null (eq (type (car (last ent))) 'ENAME)))
   (progn (setq cont (cdr(assoc 1 (entget (setq ent (car ent)))))) (command ".ddedit" ent ""))
   (progn (setq cont (vlax-get (vlax-ename->vla-object (setq ent (car (last ent)))) 'TextOverride)) (command ".ddedit" ent ""))
)
(princ "\n doi tuong duoc pick chon/ENTER ke ket thuc chon")
 
(if (and (wcmatch (cdr(assoc 0 (entget ent))) "*TEXT") (null (eq (type ent) 'ENAME)))
      (if (/= (cdr(assoc 1 (entget ent))) cont)
       (command ".chprop" ent "" "c" mausac "")
      )
)
(if (eq (type ent) 'ENAME)
 (if (= (cdr(assoc 0 (entget ent))) "DIMENSION")
   (if (/= (vlax-get (vlax-ename->vla-object ent) 'TextOverride) cont)
    ;(command ".ddedit" ent "" ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
(command ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
   )
)
(princ "\nChon doi tuong")
)
)
)
)
(princ)
)

Do nhu cầu công việc mình thấy lsp này rất tiện ích cho công việc của mình, nhưng không biết các sửa thêm tính năng như thế nào? Mong bạn Tue_NV hoặc các bạn trên diễn đàn ai biết giúp mình với: khi gõ lệnh CTE và ta chỉ chạm text hoặc dim(tất cả đều chưa sữa) thì các text và dim đó đều đổi màu(đổi sang màu số 9). Thanks các bạn

  • 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

Do nhu cầu công việc mình thấy lsp này rất tiện ích cho công việc của mình, nhưng không biết các sửa thêm tính năng như thế nào? Mong bạn Tue_NV hoặc các bạn trên diễn đàn ai biết giúp mình với: khi gõ lệnh CTE và ta chỉ chạm text hoặc dim(tất cả đều chưa sữa) thì các text và dim đó đều đổi màu(đổi sang màu số 9). Thanks các bạn

Nếu không cần sửa mà đổi màu, thì bạn chọn các đối tượng đó đưa về màu số 9 luô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
(Defun c:k()
(while
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setq nbc (getvar "clayer"))
	(setvar "cmdecho" 0)
	(command "osnap" "none")
	(initget "Heso Do")
	(setq pt (getpoint "\n HE SO / < CHON DIEM>: "))
   	(if (= pt "Heso")
	    	(progn	
			(setq am (getreal " HE SO: "))
			(if (and (null am) (/= ac 0))
				(setq am ac)
			)
		(setq pt (getpoint "\n CHON DIEM: "))	
		)
		(setq ac am))
			
	(if (or (= am 0) (null am)) (setq am 1))
	(setq s 0)
	(progn 
;		(setq pt (getpoint "\n CHON DIEM: "))	
	      (while pt
			(setq entold (cdr (assoc 5 (entget (entlast)))))
			(command "boundary" pt "")
			(setq entnew (cdr (assoc 5 (entget (entlast)))))
			(if (/= entold entnew)    
				(progn 
                        	(setq entnew (entget (entlast)))
                        	(if (assoc 62 entnew)
                          		(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
                          		(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))
                          	)
				
                          
                        	(entmod entnew)
                        	(Command "area" "o" (entlast))
					(setq s (+ s (getvar "area")))
   					(setq pt (getpoint "\n CHON DIEM: "))
					(entdel (entlast))
	        		)
				(progn
					(princ "CHON DIEM SAI")
					(setq pt (getpoint "\n CHON DIEM: "))
				)
			)
		  )

            )
	(PRINt " CHON TEXT CAP NHAT KHOI LUONG")
	(SETQ SS1 (SSGET))
	(SETQ DS (ENTGET (SSNAME SS1 0)))
	(SETQ ND (CDR (ASSOC 1 DS)))
	(SETQ LCT (STRLEN ND))
	(SETQ DEM 1)
	(SETQ DEM1 1)
	(WHILE (< DEM LCT)
		(PROGN
			(SETQ BT (SUBSTR ND DEM 1))
			(IF (= BT "=") (SETQ DEM1 DEM) (SETQ DEM1 (+ DEM1 1)))
			(IF (= BT "=") (SETQ DEM LCT) (SETQ DEM (+ DEM 1)))
		)
	)	
	(SETQ ND1 (SUBSTR ND 1 DEM1))
	(SETQ ND2 (RTOS (* S AM) 2 2))
	(SETQ ND3 (STRCAT ND2))
	(SETQ NDM (CONS 1 ND3))
	(SETQ NDC (CONS 1 ND))
	(SETQ DS (SUBST NDM NDC DS))
	(ENTMOD DS)
(setvar "cmdecho" cmd)
(setvar "clayer" nbc)
(setvar "osmode" osm)
(princ (* s am))
)
)

bạn có thể sửa hộ mình lisp này sau khi cập nhật khối lượng tự động đổi màu của text luôn được không. cảm ơn bạn nhiều

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
(Defun c:k()
(while
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setq nbc (getvar "clayer"))
	(setvar "cmdecho" 0)
	(command "osnap" "none")
	(initget "Heso Do")
	(setq pt (getpoint "\n HE SO / < CHON DIEM>: "))
   	(if (= pt "Heso")
	    	(progn	
			(setq am (getreal " HE SO: "))
			(if (and (null am) (/= ac 0))
				(setq am ac)
			)
		(setq pt (getpoint "\n CHON DIEM: "))	
		)
		(setq ac am))
			
	(if (or (= am 0) (null am)) (setq am 1))
	(setq s 0)
	(progn 
;		(setq pt (getpoint "\n CHON DIEM: "))	
	      (while pt
			(setq entold (cdr (assoc 5 (entget (entlast)))))
			(command "boundary" pt "")
			(setq entnew (cdr (assoc 5 (entget (entlast)))))
			(if (/= entold entnew)    
				(progn 
                        	(setq entnew (entget (entlast)))
                        	(if (assoc 62 entnew)
                          		(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
                          		(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))
                          	)
				
                          
                        	(entmod entnew)
                        	(Command "area" "o" (entlast))
					(setq s (+ s (getvar "area")))
   					(setq pt (getpoint "\n CHON DIEM: "))
					(entdel (entlast))
	        		)
				(progn
					(princ "CHON DIEM SAI")
					(setq pt (getpoint "\n CHON DIEM: "))
				)
			)
		  )

            )
	(PRINt " CHON TEXT CAP NHAT KHOI LUONG")
	(SETQ SS1 (SSGET))
	(SETQ DS (ENTGET (SSNAME SS1 0)))
	(SETQ ND (CDR (ASSOC 1 DS)))
	(SETQ LCT (STRLEN ND))
	(SETQ DEM 1)
	(SETQ DEM1 1)
	(WHILE (< DEM LCT)
		(PROGN
			(SETQ BT (SUBSTR ND DEM 1))
			(IF (= BT "=") (SETQ DEM1 DEM) (SETQ DEM1 (+ DEM1 1)))
			(IF (= BT "=") (SETQ DEM LCT) (SETQ DEM (+ DEM 1)))
		)
	)	
	(SETQ ND1 (SUBSTR ND 1 DEM1))
	(SETQ ND2 (RTOS (* S AM) 2 2))
	(SETQ ND3 (STRCAT ND2))
	(SETQ NDM (CONS 1 ND3))
	(SETQ NDC (CONS 1 ND))
	(SETQ DS (SUBST NDM NDC DS))
	(ENTMOD DS)
(setvar "cmdecho" cmd)
(setvar "clayer" nbc)
(setvar "osmode" osm)
(princ (* s am))
)
)

bạn có thể sửa hộ mình lisp này sau khi cập nhật khối lượng tự động đổi màu của text luôn được không. cảm ơn bạn nhiều

 

Vì Lisp này phục vụ cho nhu cầu riêng của bạn nên muốn nhanh thì hãy đính kèm bản vẽ thể hiện ý muốn :) .

  • 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

đhttp://www.cadviet.com/upfiles/5/52064_mau.dwg

đây là file bản vẽ của mình bạn giúp mình với nha

 

Bạn thêm dòng : (vla-put-color (vlax-ename->vla-object (SSNAME SS1 0)) 1)

 

dưới dòng : (ENTMOD DS)

  • 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

đhttp://www.cadviet.com/upfiles/5/52064_mau.dwg

đây là file bản vẽ của mình bạn giúp mình với nha

Nếu dùng Active-X thì như bác Tue thì nhớ thêm vào: (vl-load-com)   :) .

Còn dùng thuần Autolisp thì thêm dòng này dưới dòng : (ENTMOD DS)

(if (setq clr (assoc 62 (entget (SSNAME SS1 0)))) (entmod (subst '(62 . 1)  clr (entget (SSNAME SS1 0))))

(entmod (cons '(62 . 1) (entget (SSNAME SS1 0))))            )

  • 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

 

Vậy bạn dùng lisp này:

(defun c:CTE (/ mausac mouse cont contt ent)
(vl-load-com)
(setq mausac "1") ; thay doi mau o day
(setq mouse nil)
(prompt "\n Chon doi tuong :")
(while (/= (car mouse) 2)
(setq mouse (grread 0 15 2))
(if (= (car mouse) 3)
(if (and (setq ent (nentselp (cadr mouse)))
         (or (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT")
          (eq (type (last ent)) 'ENAME)
)
     )
   (progn
(if (and (wcmatch (cdr(assoc 0 (entget (car ent)))) "*TEXT") (null (eq (type (car (last ent))) 'ENAME)))
   (progn (setq cont (cdr(assoc 1 (entget (setq ent (car ent)))))) (command ".ddedit" ent ""))
   (progn (setq cont (vlax-get (vlax-ename->vla-object (setq ent (car (last ent)))) 'TextOverride)) (command ".ddedit" ent ""))
)
(princ "\n doi tuong duoc pick chon/ENTER ke ket thuc chon")
 
(if (and (wcmatch (cdr(assoc 0 (entget ent))) "*TEXT") (null (eq (type ent) 'ENAME)))
      (if (/= (cdr(assoc 1 (entget ent))) cont)
       (command ".chprop" ent "" "c" mausac "")
      )
)
(if (eq (type ent) 'ENAME)
 (if (= (cdr(assoc 0 (entget ent))) "DIMENSION")
   (if (/= (vlax-get (vlax-ename->vla-object ent) 'TextOverride) cont)
    ;(command ".ddedit" ent "" ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
(command ".DIMOVERRIDE" "dimclrt" mausac "" ent "") )
   )
)
(princ "\nChon doi tuong")
)
)
)
)
(princ)
)

Sao tôi Ap xong rồi đánh lênh CTE mà nó không hiểu j vậy bạ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

Sao tôi Ap xong rồi đánh lênh CTE mà nó không hiểu j vậy bạn.

 

Ở dòng Command  báo gì vậy bạ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

sao mà cho tui -1 thế. ap rồi đánh lệnh cte nó không hiểu mà

Có lẽ là do bạn không chịu theo dõi, lỗi này do bấm nút download để tải về. Lỗi loại này.đã xảy ra nhiều và cũng đã có nhiều câu trả lời.

Cách 1: Copy trực tiếp trong codebox

Cách 2:Mở bằng vlide, xoá các ký tự lạ ở đầu dòng

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

Có lẽ là do bạn không chịu theo dõi, lỗi này do bấm nút download để tải về. Lỗi loại này.đã xảy ra nhiều và cũng đã có nhiều câu trả lời.

Cách 1: Copy trực tiếp trong codebox

Cách 2:Mở bằng vlide, xoá các ký tự lạ ở đầu dòng

Nếu có 1 điểm trừ cho trường hợp này thì nên chuyển từ bạn Trinhngoctri sang bạn CadViet mới hợp lý nhỉ? Góp ý rất nhiều mà không thấy nhúc nhích.

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  

×