Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 MRCEM

MRCEM

    biết pan

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

Đã gửi 13 October 2016 - 12:40 PM

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...T0k?usp=sharing


  • -2

#2 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 13 October 2016 - 12:50 PM

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


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#3 MRCEM

MRCEM

    biết pan

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

Đã gửi 17 October 2016 - 09:46 AM

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...aWc?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


  • 0

#4 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 17 October 2016 - 10:16 AM

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...aWc?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.c...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)
  )

  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#5 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 17 October 2016 - 10:19 AM

LISP TL.

 

LISP TL đã sửa.

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...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)
  )

 


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#6 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 17 October 2016 - 10:24 AM

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...T0k?usp=sharing

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://webcache.goog...w.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)
)

  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#7 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 17 October 2016 - 10:33 AM

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

 


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#8 MRCEM

MRCEM

    biết pan

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

Đã gửi 20 October 2016 - 08:55 AM

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


  • 0

#9 MRCEM

MRCEM

    biết pan

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

Đã gửi 20 October 2016 - 09:01 AM

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


  • 0

#10 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 20 October 2016 - 01:15 PM

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

  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#11 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 256 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 20 October 2016 - 01:32 PM

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

 


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#12 MRCEM

MRCEM

    biết pan

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

Đã gửi 03 November 2016 - 10:21 AM

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

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


  • 0