Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 khongbietthihoi

khongbietthihoi

    biết zoom

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

Đã gửi 23 January 2015 - 09:28 AM

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

 


  • -1

#2 pphung183

pphung183

    biết dimstyle

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

Đã gửi 23 January 2015 - 11:39 AM

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


  • 0

#3 khongbietthihoi

khongbietthihoi

    biết zoom

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

Đã gửi 23 January 2015 - 11:53 AM

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!


  • 0

#4 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

  • Members
  • PipPipPipPipPip
  • 309 Bài viết
Điểm đánh giá: 29 (tàm tạm)

Đã gửi 23 January 2015 - 11:56 AM

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


  • 0

#5 khongbietthihoi

khongbietthihoi

    biết zoom

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

Đã gửi 23 January 2015 - 12:08 PM

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


  • -1

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 23 January 2015 - 12:08 PM

@183+090: chú ý khi color của object là bylayer thì không có assoc 62.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 trinhhoanghieu090

trinhhoanghieu090

    Edu level: li8

  • Members
  • PipPipPipPipPip
  • 309 Bài viết
Điểm đánh giá: 29 (tàm tạm)

Đã gửi 23 January 2015 - 12:21 PM

@183+090: chú ý khi color của object là bylayer thì không có assoc 62.


Hi hi, Bac Ha nhắc chuẩn quá, vừa nãy vội em chưa xem kỹ, hẹn chủ thớt đến đầu giờ chiều vậy
  • 1

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 23 January 2015 - 12:37 PM

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

  • 2

#9 khongbietthihoi

khongbietthihoi

    biết zoom

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

Đã gửi 23 January 2015 - 01:37 PM

Cảm ơn vì đã giúp... Chúc các Anh cuối tuần vui vẻ!!!  :)


  • 0

#10 pphung183

pphung183

    biết dimstyle

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

Đã gửi 23 January 2015 - 01:39 PM

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


  • 1