Đến nội dung


Hình ảnh
- - - - -

[Nhờ Chỉnh Sửa] Đổi Màu Text Kết Quả Của Lisp Tính Diện Tích


  • Please log in to reply
18 replies to this topic

#1 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 08:57 AM

Mình đang dùng lisp tính diện tích này

(defun c:edt()
(setvar "DIMZIN" 0)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1/> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))
;----------------------------------------------------------------------------
(Defun c:vld()
  (Setq pt1(getpoint"\nChon diem bat dau ve:"))
  ;(Setq s(getreal"\nCho chieu dai doan ve:"))
  ;(Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
  (While
    (Setq s(getreal"\nCho chieu dai doan ve:"))
  (Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
    (setq pt2(list ))))
	

Mình muốn chỉnh sửa thêm 1 chút là: text kết quả sau khi ed vào text có sẵn thì text đổi màu thành màu hồng.

Rất mong các bạn giúp đỡ!


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 08 July 2015 - 09:42 AM

Bạn thêm dòng này: (command "_.chprop" (entlast) "" "C" 6 "") ngay sau dòng: (entmod elst). Trong đó 6 là màu.


  • 0

#3 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 09:51 AM

Bạn thêm dòng này: (command "_.chprop" (entlast) "" "C" 6 "") ngay sau dòng: (entmod elst). Trong đó 6 là màu.

Mình đã thêm như bạn nói nhưng chưa được bạn ah? Bạn check giúp mình lại nhé.

(command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
(command "_.chprop" (entlast) "" "C" 6 "")
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)

  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#4 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 08 July 2015 - 09:54 AM

Máy nó báo thế nào?


  • 0

#5 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 09:57 AM

Sửa cho bạn đây!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/141684-nha-cha-nh-sa-a-a-i-ma-u-text-ka-t-qua-ca-a-lisp-ta-nh-dia-n-ta-ch/
(defun c:edt( / DTCON DTL ELST ET NTL OSLAST PT1 SS TL TL2 VSIZE)
(setvar "DIMZIN" 0)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1/> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (setq elst (subst (cons 62 6) (assoc 62 elst) elst))
  (entmod elst)
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))
;----------------------------------------------------------------------------
(Defun c:vld( / PT PT1 PT2 S)
  (Setq pt1(getpoint"\nChon diem bat dau ve:"))
  ;(Setq s(getreal"\nCho chieu dai doan ve:"))
  ;(Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
  (While
    (Setq s(getreal"\nCho chieu dai doan ve:"))
  (Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
    (setq pt2(list ))))
	


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#6 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 10:04 AM

Máy nó báo thế nào?

Máy ko báo gì cả. Chỉ là text kết quả chưa tự động đổi màu bạn ah.


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#7 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 10:08 AM

 

Sửa cho bạn đây!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/141684-nha-cha-nh-sa-a-a-i-ma-u-text-ka-t-qua-ca-a-lisp-ta-nh-dia-n-ta-ch/
(defun c:edt( / DTCON DTL ELST ET NTL OSLAST PT1 SS TL TL2 VSIZE)
(setvar "DIMZIN" 0)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1/> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (setq elst (subst (cons 62 6) (assoc 62 elst) elst))
  (entmod elst)
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))
;----------------------------------------------------------------------------
(Defun c:vld( / PT PT1 PT2 S)
  (Setq pt1(getpoint"\nChon diem bat dau ve:"))
  ;(Setq s(getreal"\nCho chieu dai doan ve:"))
  ;(Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
  (While
    (Setq s(getreal"\nCho chieu dai doan ve:"))
  (Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
    (setq pt2(list ))))
	

Cám ơn bạn nhé. Tuy nhiên text kết quả cũng vẫn chưa tự chuyển sang màu hồng bạn ah. Mà giờ mỗi lần gọi lại lệnh nó lại bắt lựa chọn tỷ lệ. Trước đó tỷ lệ chỉ cần lựa chọn 1 lần thôi bạn.


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#8 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 10:10 AM

Mình chỉ sửa cái chọn Text để sửa kết quả để nó thành màu 6. Mình ko sửa gì khác. Yêu cầu của bạn lại đi xa nội dung rồi.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 10:14 AM

Bạn xóa cái TL, NTL, TL2 trong (defun c:edt( / DTCON DTL ELST ET NTL OSLAST PT1 SS TL TL2 VSIZE)

Thành (defun c:edt( / DTCON DTL ELST ET OSLAST PT1 SSVSIZE)


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#10 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 10:18 AM

Mình chỉ sửa cái chọn Text để sửa kết quả để nó thành màu 6. Mình ko sửa gì khác. Yêu cầu của bạn lại đi xa nội dung rồi.

Mình ko có yêu cầu gì khác. Chỉ muốn đổi màu của text kết quả. Nhưng mừ lisp bạn sửa cho mình vẫn chưa làm được điều đó mà. Chữ chưa chuyển được màu bạn ah. 

Bạn thêm dòng này phải ko nhỉ? 

(setq elst (subst (cons 62 6) (assoc 62 elst) elst))
  (entmod elst)

  • -1

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#11 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 10:23 AM

Bạn xóa cái TL, NTL, TL2 trong (defun c:edt( / DTCON DTL ELST ET NTL OSLAST PT1 SS TL TL2 VSIZE)

Thành (defun c:edt( / DTCON DTL ELST ET OSLAST PT1 SSVSIZE)

:)  hì. vẫn chưa đổi màu bạn ah. 


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#12 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 10:28 AM

Của bạn đây.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/141684-nha-cha-nh-sa-a-a-i-ma-u-text-ka-t-qua-ca-a-lisp-ta-nh-dia-n-ta-ch/
(defun c:edt( / DTCON DTL ELST ET OSLAST PT1 SS VSIZE ObjText)
(setvar "DIMZIN" 0)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq ObjText  (car (entsel "Thay cho so: ")))
  (setq elst (entget ObjText))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (vla-put-color
      (vlax-ename->vla-object ObjText)
      6
    )

  
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))
;----------------------------------------------------------------------------
(Defun c:vld( / PT PT1 PT2 S)
  (Setq pt1(getpoint"\nChon diem bat dau ve:"))
  ;(Setq s(getreal"\nCho chieu dai doan ve:"))
  ;(Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
  (While
    (Setq s(getreal"\nCho chieu dai doan ve:"))
  (Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
    (setq pt2(list ))))
	


  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#13 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 08 July 2015 - 10:29 AM

:)  hì. vẫn chưa đổi màu bạn ah. 

Hề hề hề, 

Thanhduan2407 quên rằng nếu text có màu là bylayer thì sẽ không có mã dxf 62.

Do vậy cần thêm một hàm điều kiện vào đó là Ok Thanhduan ạ.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#14 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 10:31 AM

Bạn dùng chương trình này của mình xem

(defun c:tdt ( / Olmode Clor loop Pnt e    )
(vl-load-com)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if Clor (setvar 'CECOLOR Clor))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(_layer2 "Dtich" 2)
(setq Olmode (getvar "OSMODE"))
(setvar "hpgaptol" 0.5)
(setvar "OSMODE" 0)
(setvar "CECOLOR" "ByLayer")
(setq Clor (getvar "CECOLOR"))
(setvar "CECOLOR" "2")
(or *chieucao* (setq *chieucao* 0.5))
(setq chieucao (getreal (strcat "\n Chieu cao text <"
			  (rtos *chieucao* 2 2)
			 "> :"
		  )
	 )
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))


  
(setq loop T)
(while loop
	(setq Pnt (getpoint "\nPick \U+0111i\U+1EC3m trong v\U+00F9ng c\U+1EA7n t\U+00EDnh di\U+1EC7n t\U+00EDch: "))
  	(cond
	  (T
		(if Pnt
		  (progn
			(vl-cmdf  "-boundary" Pnt "")
		    	(setq e (entlast))
			(entmake (list (cons 0 "TEXT") (cons 10 Pnt) (cons 40  chieucao) (cons 8  "Dtich") (cons 1  (rtos (Area e) 2 3))))
			(entdel e)
		    	
		  )
		  (setq loop nil)
		)
	  )
	)
)
(setvar "CECOLOR" "ByLayer")
(setvar "OSMODE" Olmode)
(princ)
)






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Area (ent)
(setvar "hpgaptol" 0.1)
(vla-get-area (vlax-ename->vla-object ent))
)
(defun mid (ent / p1 p2)
	(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
	(setq p1 (vlax-safearray->list p1)
				p2 (vlax-safearray->list p2)
				pt (mapcar '+ p1 p2)
				pt (mapcar '* pt '(0.5 0.5 0.5))
	)
	pt
)






(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#15 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 10:36 AM

 

Của bạn đây.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/141684-nha-cha-nh-sa-a-a-i-ma-u-text-ka-t-qua-ca-a-lisp-ta-nh-dia-n-ta-ch/
(defun c:edt( / DTCON DTL ELST ET OSLAST PT1 SS VSIZE ObjText)
(setvar "DIMZIN" 0)
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq ObjText  (car (entsel "Thay cho so: ")))
  (setq elst (entget ObjText))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  (vla-put-color
      (vlax-ename->vla-object ObjText)
      6
    )

  
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))
;----------------------------------------------------------------------------
(Defun c:vld( / PT PT1 PT2 S)
  (Setq pt1(getpoint"\nChon diem bat dau ve:"))
  ;(Setq s(getreal"\nCho chieu dai doan ve:"))
  ;(Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
  (While
    (Setq s(getreal"\nCho chieu dai doan ve:"))
  (Setq pt(getreal"\nCho do doc cua duong thang<%>:"))
    (setq pt2(list ))))
	

Được rùi bạn ah. thanks all!  :)


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#16 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 08 July 2015 - 10:40 AM

Bạn thêm dòng này: (command "_.chprop" (entlast) "" "C" 6 "") ngay sau dòng: (entmod elst). Trong đó 6 là màu.

Hề hề hề,

Bạn chú ý rằng hàm (entmod ...) không tạo ra đối tượng mới mà chỉ modify đối tượng cũ. Do đó chưa chắc cái (entlast) đã đúng là cái được (entmod ...).


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#17 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 08 July 2015 - 10:48 AM

Hề hề hề,

Bạn chú ý rằng hàm (entmod ...) không tạo ra đối tượng mới mà chỉ modify đối tượng cũ. Do đó chưa chắc cái (entlast) đã đúng là cái được (entmod ...).

Vâng cám ơn bác, em nhầm, lẽ ra phải thế này: (if (setq clr (assoc 62 elst)) (entmod (subst (cons 62 6) clr elst)) (entmod (append elst (list (cons 62 6)))))


  • 0

#18 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 08 July 2015 - 11:21 AM

Gà gô như mình lại phải nhờ các bạn chút. 

Tương tự như trên, mình cũng thêm đoạn code như của bạn thanhduan2407 vào để đổi màu text kết quả của lisp tính chiều dài này. Nhưng ko đạt như ý.

Lisp gốc: 

;; free lisp from cadviet.com
;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
;; free lisp from cadviet.com
;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:tgl( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
(princ (strcat "\nTong chieu dai la : " (rtos L)))
)
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)

Lisp mình tự sửa:

;; free lisp from cadviet.com
;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
;; free lisp from cadviet.com
;;;--------------------------------------------------------------------
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:ttgl( / ss L e ObjText te)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
)
(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (+ L (length1 e)))
(ssdel e ss)
(princ (strcat "\nTong chieu dai la : " (rtos L)))
)
(setq ObjText  (car (entsel"\n Chon Text de gan ket qua :")))
(setq te (entget ObjText))
setq te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
(vla-put-color
      (vlax-ename->vla-object ObjText)
      6
)

Nhờ các bạn chỉ giáo!


  • -1

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#19 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 July 2015 - 11:32 AM

Bạn chưa biết sửa

(defun Length1 (e)
  (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;--------------------------------------------------------------------
(defun C:tgl (/ ss L e)
  (setq
    ss (ssget
	 (list
	   (cons 0
		 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"
	   )
	 )
       )
    L  0.0
  )
  (vl-load-com)
  (while (setq e (ssname ss 0))
    (setq L (+ L (length1 e)))
    (ssdel e ss)
    (princ (strcat "\nTong chieu dai la : " (rtos L)))
  )
  (setq ObjText (car (entsel "\n Chon Text de gan ket qua :")))
  (setq	te (entget ObjText)
	te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te)
  )
  (entmod te)
  (vla-put-color
    (vlax-ename->vla-object ObjText)
    6
  )
  (princ)
)


  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn