Lisp Cũ - Người Mới Cần Giúp Đỡ

[MRCEM 2]

bác nào rảnh tay giúp em thêm đoạn xuất kết quả vào text có tiền tố, hậu tố

vd: A=10m2, L=2m

lisp này cũ cũng của các bác trên 4room nhưng em tìm mãi không được lisp ưng ý trên 4room hoặc không xài được. mong các bác giúp

sẵn tiện lisp "ss" bác có thể sửa để cộng nhiều đối tượng tính diện tích không ak

lisp của em đây. Thx các bác

https://drive.google.com/drive/folders/0B18eA56nV_lKQjJIZmpLclltT0k?usp=sharing

[Danh Cong 422]

Lisp cần sửa là lisp nào trong khoảng 2 chục cái lisp vậy? 

---->

Bạn bảo bị đau , nhưng ko nói bị đau ở đâu thì bác sĩ biết bạn đang bị bệnh gì ? !!!!!

[MRCEM 2]

Lisp cần sửa là lisp nào trong khoảng 2 chục cái lisp vậy? 

---->

Bạn bảo bị đau , nhưng ko nói bị đau ở đâu thì bác sĩ biết bạn đang bị bệnh gì ? !!!!!

Em xin lỗi bác, em add nhầm folder. Em chỉ nhờ 2 lisp này thôi ak

https://drive.google.com/drive/folders/0B18eA56nV_lKanAwdjlPb1dlaWc?usp=sharing

cái lisp "ss" bác cho em cộng nhiều đối tượng được thì em cảm ơn nhiều

[Danh Cong 422]

LISP TL đã sửa.

 

Em xin lỗi bác, em add nhầm folder. Em chỉ nhờ 2 lisp này thôi ak

https://drive.google.com/drive/folders/0B18eA56nV_lKanAwdjlPb1dlaWc?usp=sharing

cái lisp "ss" bác cho em cộng nhiều đối tượng được thì em cảm ơn nhiều

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=33112

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

;;;--------------------------------------------------------------------

(defun C:TL( / 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)

)

(setq ptext (getpoint "Moi ban chon diem chen Text ^^ \n"))

(command "-text" ptext "" "" (strcat "L=" (rtos L 2 2) " M" ))

  (princ)

  )

[Danh Cong 422]

LISP TL.

 

LISP TL đã sửa.

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=33112

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

;;;--------------------------------------------------------------------

(defun C:TL( / 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)

)

(setq ptext (getpoint "Moi ban chon diem chen Text ^^ \n"))

(command "-text" ptext "" "" (strcat "L=" (rtos L 2 2) " M" ))

  (princ)

  )

 

[Danh Cong 422]

LISP SS của bạn có vấn đề gì đó mà mình ko chạy được. Nhưng mình cũng sửa 1 lisp cũ của bác nào đó theo ý bạn. Tác dụng tương tự.

bác nào rảnh tay giúp em thêm đoạn xuất kết quả vào text có tiền tố, hậu tố

vd: A=10m2, L=2m

lisp này cũ cũng của các bác trên 4room nhưng em tìm mãi không được lisp ưng ý trên 4room hoặc không xài được. mong các bác giúp

sẵn tiện lisp "ss" bác có thể sửa để cộng nhiều đối tượng tính diện tích không ak

lisp của em đây. Thx các bác

https://drive.google.com/drive/folders/0B18eA56nV_lKQjJIZmpLclltT0k?usp=sharing

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://webcache.googleusercontent.com/search?q=cache:R2kCctDqgFAJ:www.cadviet.com/forum/index.php%3Fshowtopic%3D16363+%22t%C3%ADnh+di%E1%BB%87n+t%C3%ADch+nhi%E1%BB%81u+h%C3%ACnh%22&cd=1&hl=vi&ct=clnk&gl=vn&source=www.google.com.vn

(defun c:gb(/ p ss S frome cur toe tt)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 

ss (ssadd) S 0)

(while p

(setq frome (entlast))

(command ".boundary" p "")

(setq toe (entlast));; 

(setq cur frome

)

    (while (not (eq cur toe))

(setq cur (entnext cur)

ss (ssadd cur ss))

(command "area" "S" "O" ss "" "")

(setq tt (getvar "area"))

(setq S (+ S tt))

     )

  (command "area" "A" "O" "L" "" "")

  (setq tt (getvar "area"))

  (setq S (+ S (* tt 2))) 

(sssetfirst ss ss)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :"))

 

)

(if (> (sslength ss) 0)

(progn 

(princ (strcat "Area = " (rtos S 2 2)))

(setq ptext (getpoint "Moi ban chon diem chen Text ^^ \n"))

(command "-text" ptext "" "" (strcat "A=" (rtos S 2 2) " M2" ))

)

(alert "\n Ban chua Pick vao mien kin nao ca ")

)

(command "erase" ss "")

(Princ)

)

[Danh Cong 422]

LISP ghi diện tích. Lệnh GB.

 

(defun c:gb(/ p ss S frome cur toe tt)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 

ss (ssadd) S 0)

(while p

(setq frome (entlast))

(command ".boundary" p "")

(setq toe (entlast));; 

(setq cur frome

)

    (while (not (eq cur toe))

(setq cur (entnext cur)

ss (ssadd cur ss))

(command "area" "S" "O" ss "" "")

(setq tt (getvar "area"))

(setq S (+ S tt))

     )

  (command "area" "A" "O" "L" "" "")

  (setq tt (getvar "area"))

  (setq S (+ S (* tt 2))) 

(sssetfirst ss ss)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :"))

 

)

(if (> (sslength ss) 0)

(progn 

(princ (strcat "Area = " (rtos S 2 2)))

(setq ptext (getpoint "Moi ban chon diem chen Text ^^ \n"))

(command "-text" ptext "" "" (strcat "A=" (rtos S 2 2) " M2" ))

)

(alert "\n Ban chua Pick vao mien kin nao ca ")

)

(command "erase" ss "")

(Princ)

)

 

[MRCEM 2]

LISP TL.

 

Em cám ơn bác giúp đỡ. Lisp bác sửa chạy rất tốt. Mấy hôm web em nó cà zựt ko replay thx bác được.

Bác giúp em thêm đoạn chèn kết quả vào text hoặc mtext theo font có trước được không bác. vẫn giữ tiền tố hậu tố như vậy nhé.

Chả là em làm form xuất hết rồi nên em nhờ bác.

thx bác, chúc bác sức khỏe

[MRCEM 2]

LISP ghi diện tích. Lệnh GB.

 

 

Cả cái lisp GB bác làm giúp em nữa. Bác thêm cho em chèn vào text/Mtext theo font có trước với nhé.

Bác giữ cả cái tiền tố và hậu tố giúp em

Thx bác

[Danh Cong 422]

Sửa lần 2:

 

Cả cái lisp GB bác làm giúp em nữa. Bác thêm cho em chèn vào text/Mtext theo font có trước với nhé.

Bác giữ cả cái tiền tố và hậu tố giúp em

Thx bác

 

 

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

;;;--------------------------------------------------------------------

(defun C:TL( / 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)

)

;;;;; Chon text thay ket qua

  (setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

  (setq sstext (subst (cons 1 (strcat "L=" (rtos L 2 2) " M" )) (assoc 1 (entget sstext)) (entget sstext)))

  (ENTMOD sstext)

  (princ)

  )

 

 

 

 

 

 

(defun c:gb(/ p ss S frome cur toe tt)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 

ss (ssadd) S 0)

(while p

(setq frome (entlast))

(command ".boundary" p "")

(setq toe (entlast));; 

(setq cur frome

)

    (while (not (eq cur toe))

(setq cur (entnext cur)

ss (ssadd cur ss))

(command "area" "S" "O" ss "" "")

(setq tt (getvar "area"))

(setq S (+ S tt))

     )

  (command "area" "A" "O" "L" "" "")

  (setq tt (getvar "area"))

  (setq S (+ S (* tt 2))) 

(sssetfirst ss ss)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :"))

 

)

(if (> (sslength ss) 0)

(progn 

(princ (strcat "Area = " (rtos S 2 2)))

;;;;; Chon text thay ket qua

  (setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

  (setq sstext (subst (cons 1 (strcat "A=" (rtos S 2 2) " M2" )) (assoc 1 (entget sstext)) (entget sstext)))

  (ENTMOD sstext)

 

)

(alert "\n Ban chua Pick vao mien kin nao ca ")

)

(command "erase" ss "")

(Princ)

)

[Danh Cong 422]

Đã chỉnh sửa cả 2 lisp.

 

 

(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

;;;--------------------------------------------------------------------

(defun C:TL( / 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)

)

;;;;; Chon text thay ket qua

  (setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

  (setq sstext (subst (cons 1 (strcat "L=" (rtos L 2 2) " M" )) (assoc 1 (entget sstext)) (entget sstext)))

  (ENTMOD sstext)

  (princ)

  )

 

 

(defun c:gb(/ p ss S frome cur toe tt)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 

ss (ssadd) S 0)

(while p

(setq frome (entlast))

(command ".boundary" p "")

(setq toe (entlast));; 

(setq cur frome

)

    (while (not (eq cur toe))

(setq cur (entnext cur)

ss (ssadd cur ss))

(command "area" "S" "O" ss "" "")

(setq tt (getvar "area"))

(setq S (+ S tt))

     )

  (command "area" "A" "O" "L" "" "")

  (setq tt (getvar "area"))

  (setq S (+ S (* tt 2))) 

(sssetfirst ss ss)

(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :"))

 

)

(if (> (sslength ss) 0)

(progn 

(princ (strcat "Area = " (rtos S 2 2)))

;;;;; Chon text thay ket qua

  (setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

  (setq sstext (subst (cons 1 (strcat "A=" (rtos S 2 2) " M2" )) (assoc 1 (entget sstext)) (entget sstext)))

  (ENTMOD sstext)

 

)

(alert "\n Ban chua Pick vao mien kin nao ca ")

)

(command "erase" ss "")

(Princ)

)

 

[MRCEM 2]

Đã chỉnh sửa cả 2 lisp.

Em cám ơn bác. Lisp chạy rất tốt