Chuyển đến nội dung
Diễn đàn CADViet
bach1212

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

Bởi bach1212 , trong AutoLisp

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

bach1212    4

bach1212
Đã đăng

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 đỡ!

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

bach1212    4

bach1212
Đã đăng

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)

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

thanhduan2407    272

thanhduan2407
Đã đăng

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

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

bach1212    4

bach1212
Đã đăng

 

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.

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

thanhduan2407    272

thanhduan2407
Đã đăng

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.

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

thanhduan2407    272

thanhduan2407
Đã đăng

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)

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

bach1212    4

bach1212
Đã đăng

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

bach1212    4

bach1212
Đã đăng

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. 

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

thanhduan2407    272

thanhduan2407
Đã đăng

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

:)  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 ạ.

  • 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

thanhduan2407    272

thanhduan2407
Đã đăng

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

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

bach1212    4

bach1212
Đã đăng

 

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

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

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

  • 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

quocmanh04tt    635

quocmanh04tt
Đã đăng

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

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

bach1212    4

bach1212
Đã đăng

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!

  • 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

thanhduan2407    272

thanhduan2407
Đã đăng

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)
)
  • 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
Về Đầu Trang AutoLisp
×