Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
khongbietthihoi

[Yêu cầu] Sửa lisp đổi màu giá trị Text?

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

Em không rành về autolisp… Em có đoạn code tính tổng chiều dài các đoạn thẳng sau đó gán vào giá trị Text. Mong các anh sửa giúp "Giá trị text đổi thành màu ĐỎ sau khi gán giá trị". Chân thành cảm ơn.

(defun C:TCD (/ tot_len ss e_name e_record e_type)
  (setq tot_len 0.0)
  (setq ss (ssget))
  (if (null ss)
    (exit)
  )
  (while (> (sslength ss) 0)
    (setq e_name (ssname ss 0))
    (setq e_record (entget e_name))
    (setq e_type (cdr (assoc '0 e_record)))
    (cond ((wcmatch e_type
		    "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"
	   )
	   (command "lengthen" e_name "")
	   (setq tot_len (+ tot_len (getvar "PERIMETER")))
	   (ssdel e_name ss)
	  )
	  ((wcmatch e_type "MLINE") (add_mline))
	  (e_type (ssdel e_name ss))
    )
  )
  (setq	te (entget (car (entsel "\n Chon Text de gan ket qua :")))
	te (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)
  )
  (entmod te)
  (princ)
)

 

  • 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

Bạn sửa :

  (setq     te (entget (car (entsel "\n Chon Text de gan ket qua :")))              

              te (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)              

               )

thành :

  (setq     te (entget (car (entsel "\n Chon Text de gan ket qua :")))              

              te (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)              

              te (subst (cons 62 1) (assoc 62 te) te)  )

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

Em đã sửa nhưng không thấy giá trị text đổi màu, không biết có nhầm chỗ nào không? Anh xem lại giúp em!

(setq     te (entget (car (entsel "\n Chon Text de gan ket qua :")))              

              te1 (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)              

              te2 (subst (cons 62 1) (assoc 62 te) te)  )

Bạn sửa thế này thử xem

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

(setq     te (entget (car (entsel "\n Chon Text de gan ket qua :")))              

              te1 (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)              

              te2 (subst (cons 62 1) (assoc 62 te) te)  )

Bạn sửa thế này thử xem

Không được luôn Anh ơi, sửa như trên lisp không tính được chiều dài đối tượng... Anh xem lại giúp em!

  • 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

 Đây là dịp để tập xài hàm vla.

Sửa thành 

 

(setq  te (vlax-ename->vla-object (car (entsel "\n Chon Text de gan ket qua :")) )            
       te1 (vla-put-Textstring  te (rtos tot_len 2 2))   
       te2 (vla-put-color te 1)
)
(setq  te (vlax-ename->vla-object (car (entsel "\n Chon Text de gan ket qua :")) )            
       te1 (vla-put-Textstring  te (rtos tot_len 2 2))   
       te2 (vla-put-color te 1)
)
  • 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

Hehe, xớn xác tra mã DXF ngay thằng Text dạng không phải Bylayer :P  nên quất luôn.

Bạn thêm (vl-load-com)  đầu hàm TCD rồi thay :

(setq    te (entget (car (entsel "\n Chon Text de gan ket qua :")))
           te (subst (cons 1 (rtos tot_len 2 2)) (assoc 1 te) te)
           )
(entmod te)

bằng đoạn code của bác Tot77 là OK :D

  • 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

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  

×