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

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

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

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

  • Vote giảm 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

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ì ? !!!!!

  • 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

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

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

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

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

LISP TL.

 

LISP TL đã sửa.

 

;; free lisp from cadviet.com
(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)
  )

 

  • 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

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

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

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

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

 

  • 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

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

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

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

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

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

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

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

 

  • 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


×