Đến nội dung


Hình ảnh
- - - - -

Nhờ viết Lisp diện tích, nhân nhanh


  • Please log in to reply
4 replies to this topic

#1 friendship293a

friendship293a

    biết lệnh erase

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

Đã gửi 25 November 2010 - 04:19 PM

Em đang cần 3 lisp tính diện tích và nhân nhanh cụ thể là thế này
1. Lisp tính diện tích nhanh. đánh lệnh rồi chọn khung bo hoặc pick điểm enter chọn text ghi kết quả xong.
2. lisp nhân nhanh. chọn số thứ nhất rùi chọn số thứ 2 rùi chọn text ghi kết quả đơn giản không phải enter nhiều lần
3. Lisp tính diện tích và nhân.đánh lệnh rùi chọn khung bo hoặc pick điểm enter chọn sô cần nhân vào giá trị diện tích, chọn text ghi kết quả.

EM đã tìm trên diễn đàn nhưng lisp chưa được như ý nên mong ai hiểu biết về lisp giúp đỡ ạ. Cảm ơn mọi người.
  • 0

#2 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 25 November 2010 - 05:33 PM

Em đang cần 3 lisp tính diện tích và nhân nhanh cụ thể là thế này
1. Lisp tính diện tích nhanh. đánh lệnh rồi chọn khung bo hoặc pick điểm enter chọn text ghi kết quả xong.
2. lisp nhân nhanh. chọn số thứ nhất rùi chọn số thứ 2 rùi chọn text ghi kết quả đơn giản không phải enter nhiều lần
3. Lisp tính diện tích và nhân.đánh lệnh rùi chọn khung bo hoặc pick điểm enter chọn sô cần nhân vào giá trị diện tích, chọn text ghi kết quả.

EM đã tìm trên diễn đàn nhưng lisp chưa được như ý nên mong ai hiểu biết về lisp giúp đỡ ạ. Cảm ơn mọi người.

Mình viết cái lõi lisp cho bạn. Còn thêm mắm thêm muối gì tì tuỳ bạn nhé.

(defun c:nhant ()
(setq tn1 (atof (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nChon text 1: "))))))
(setq tn2 (atof (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nChon text 2: "))))))
(setq ent (entget (car (entsel "\nChon text ghi ket qua: "))))
(setq kq (* tn1 tn2))
(entmod (subst (cons 1 (rtos kq 2 3)) (assoc 1 ent) ent))
)
(defun c:dt ()
(setq p (getpoint "\nPick trong vung can tinh dien tich: "))
(setq txt (entget (car (entsel "\nChon text ghi ket qua: "))))
(setq nh (getreal "\nNhap so muon nhan voi dien tich: "))
(setq kq (* (dientich p) nh))
(entmod (subst (cons 1 (rtos kq 2 3)) (assoc 1 txt) txt))
)
(defun dientich ( pt /)
(command "-boundary" pt ""
(if (/= (getvar "cmdactive") 0)
(command "")
)
)
(setq el (entlast))
(if (= (cdr (assoc 0 (entget el))) "LWPOLYLINE")
(progn
(command "region" el "")
(setq el (entlast))
)
)
(setq dt (vla-get-area (vlax-ename->vla-object el)))
(command "undo" 1)
dt
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#3 friendship293a

friendship293a

    biết lệnh erase

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

Đã gửi 26 November 2010 - 08:30 AM

Code của bạn chạy rất tốt nhưng minhg mù tịt về lisp muốn sửa tí nhưng chẳng bít sửa thế nào. Đã giúp thì giúp cho chót hì hì cụ thể là
1. Lisp tính diện tích rùi ghi kết qủa trực tiếp vào 1 text có sẵn chưa có
2.Lisp nhân nhanh của bạn chạy rất tốt không chê vào đâu được hì hì
3. Lisp tính diện tích rùi nhân và ghi kết quả thì text để nhân là text được chọn trên màn hình chứ không phải là nhập từ bàn phím

Cảm ơn bạn đã giúp đỡ
  • 0

#4 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 26 November 2010 - 08:56 AM

Code của bạn chạy rất tốt nhưng minhg mù tịt về lisp muốn sửa tí nhưng chẳng bít sửa thế nào. Đã giúp thì giúp cho chót hì hì cụ thể là
1. Lisp tính diện tích rùi ghi kết qủa trực tiếp vào 1 text có sẵn chưa có
2.Lisp nhân nhanh của bạn chạy rất tốt không chê vào đâu được hì hì
3. Lisp tính diện tích rùi nhân và ghi kết quả thì text để nhân là text được chọn trên màn hình chứ không phải là nhập từ bàn phím

Cảm ơn bạn đã giúp đỡ

Của bạn đây:

(defun c:dt ()
(setq p (getpoint "\nPick trong vung can tinh dien tich: "))
(setq txt (entget (car (entsel "\nChon text ghi ket qua: "))))
(setq kq (dientich p))
(entmod (subst (cons 1 (rtos kq 2 3)) (assoc 1 txt) txt))
)
(defun c:nhant ()
(setq tn1 (atof (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nChon text 1: "))))))
(setq tn2 (atof (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nChon text 2: "))))))
(setq ent (entget (car (entsel "\nChon text ghi ket qua: "))))
(setq kq (* tn1 tn2))
(entmod (subst (cons 1 (rtos kq 2 3)) (assoc 1 ent) ent))
)
(defun c:dtn ()
(setq p (getpoint "\nPick trong vung can tinh dien tich: "))
(setq nh (atof (vla-get-textstring (vlax-ename->vla-object (car (entsel "\nChon text de nhan: "))))))
(setq txt (entget (car (entsel "\nChon text ghi ket qua: "))))
(setq kq (* (dientich p) nh))
(entmod (subst (cons 1 (rtos kq 2 3)) (assoc 1 txt) txt))
)
(defun dientich ( pt /)
(command "-boundary" pt ""
(if (/= (getvar "cmdactive") 0)
(command "")
)
)
(setq el (entlast))
(if (= (cdr (assoc 0 (entget el))) "LWPOLYLINE")
(progn
(command "region" el "")
(setq el (entlast))
)
)
(setq dt (vla-get-area (vlax-ename->vla-object el)))
(command "undo" 1)
dt
)
(vl-load-com)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#5 friendship293a

friendship293a

    biết lệnh erase

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

Đã gửi 26 November 2010 - 10:46 AM

Cảm ơn bạn. bạn viết Lisp quá siêu mình đã test không thể chê vào đâu được :leluoi:
  • 0