Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] lisp tính diện tích hình chữ nhật bằng cách đo 2 cạnh


  • Please log in to reply
29 replies to this topic

#21 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 16 June 2011 - 11:47 AM

Ket có nói rồi nè ^^ Nhưng mà cái phần ghi file ketxu cũng dốt đặc, chỉ chém ra cái cớ thế thôi :(

cái này bác nói e ko hiểu lắm.
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^

#22 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 04 July 2011 - 10:27 AM

Bạn có thể sử dụng lệnh DATAEXTRACTION để xuất dữ liệu. Bạn chịu khó tìm kiếm lệnh này trên diễn đàn, đọc, hiểu nó nhé

Tình hình thế này các bác a. E đã tìm hiểu về lệnh DATAEXTRACTION.
e cũng tìm đc 1 cái lisp có thể đáp ứng nhu cầu của e do bác thaistreet viết.

http://www.cadviet.c...showtopic=12432

có điều e muốn nhờ các bác sửa giúp e cái phần tính diện tích, thay vì pick điểm nó cho phép đo 2 cạnh như dùng lệnh DLI ấy.
Em cảm ơn các bác.
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^

#23 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 July 2011 - 02:09 PM

Tình hình thế này các bác a. E đã tìm hiểu về lệnh DATAEXTRACTION.
e cũng tìm đc 1 cái lisp có thể đáp ứng nhu cầu của e do bác thaistreet viết.

http://www.cadviet.c...showtopic=12432

có điều e muốn nhờ các bác sửa giúp e cái phần tính diện tích, thay vì pick điểm nó cho phép đo 2 cạnh như dùng lệnh DLI ấy.
Em cảm ơn các bác.

Cái lisp nào trong đống lisp ấy ???
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 04 July 2011 - 02:17 PM

Cái lisp nào trong đống lisp ấy ???

Lại bác ketxu chăm chỉ nhất :D
http://www.cadviet.c...files/3/bdt.lsp
e cám ơn bác trc.
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^

#25 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 July 2011 - 03:23 PM

Câu chăm chỉ mình cũng không dám nhận. Coding vội, còn nhiều thứ tiểu tiết bạn cứ nói mình thêm sau, giờ mần việc khác ^^
(defun c:bdt(/ ptt1 ptt2 ptt3)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DiÖn tÝch (m2)"
);command
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))

(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil))
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "cecolor"4 ".rectang" ptt1 ptt3);; boundary
(command "area" "O" "L")
(setq dt (* (getvar "area") tl tl) tdt (+ tdt dt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dt 2 2))
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
);while

(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"text" "m" P12 h 0 "Tæng"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#26 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 04 July 2011 - 03:53 PM

Câu chăm chỉ mình cũng không dám nhận. Coding vội, còn nhiều thứ tiểu tiết bạn cứ nói mình thêm sau, giờ mần việc khác ^^

(defun c:bdt(/ ptt1 ptt2 ptt3)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P6 (* 1.2 h) 0 "%%UB¶ng thèng kª diÖn tÝch"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DiÖn tÝch (m2)"
);command
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))

(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil))
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "cecolor"4 ".rectang" ptt1 ptt3);; boundary
(command "area" "O" "L")
(setq dt (* (getvar "area") tl tl) tdt (+ tdt dt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dt 2 2))
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
);while

(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"text" "m" P12 h 0 "Tæng"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

Lisp chạy đúng nhưng còn 1 vài vấn đề:
- mỗi lần chạy lệnh osnap đều phải chọn lại dù đã bật sẵn.
- cách bắt 3 điểm chỉ làm đc khi điểm thứ 2 và 3 là điểm góc, em muốn chọn 2 điểm của cạnh 1 rùi tới 2 điểm của cạnh 2 riêng rẽ và 4 điểm đó có thể là 4 điểm bất kỳ thuộc 4 cạnh chứ không nhất thiết phải là điểm góc.
- đơn vị tính đang là mm, bác chuyển kết quả về m giúp e và chỉ cần 2 số sau dấu phẩy thôi a.
Em cám ơn bác.
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^

#27 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 July 2011 - 04:06 PM

Lisp chạy đúng nhưng còn 1 vài vấn đề:
- mỗi lần chạy lệnh osnap đều phải chọn lại dù đã bật sẵn.
- cách bắt 3 điểm chỉ làm đc khi điểm thứ 2 và 3 là điểm góc, em muốn chọn 2 điểm của cạnh 1 rùi tới 2 điểm của cạnh 2 riêng rẽ và 4 điểm đó có thể là 4 điểm bất kỳ thuộc 4 cạnh chứ không nhất thiết phải là điểm góc.
- đơn vị tính đang là mm, bác chuyển kết quả về m giúp e và chỉ cần 2 số sau dấu phẩy thôi a.
Em cám ơn bác.

- 1,3 : OK
- 2 : nếu bạn chọn 4 điểm bất kỳ, chẳng may nó không là 4 điểm của 2 cạnh vuông góc thì bạn muốn tính DT theo kiểu gì đây, hay chỉ là chiều dài x chiều rộng và cũng không thiết phải tạo cho bạn cái preview như lisp đang làm ??? :)
Update cái mới dễ nhìn hơn :
(defun c:bdt(/ ptt1 ptt2 ptt3)
(defun wtxt_l(txt p h);;;Write txt on graphic screen at p
(entmake (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 40 h)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(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
)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" "_non" PT P2 P5 P3 "C" "pline" P1 P4 "")
(wtxt_l "% ¶ng thèng kª diÖn tÝch" P6 (* 1.2 h))
(wtxt_l "STT" P7 h)
(wtxt_l "DiÖn tÝch (m2)" P8 h)
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil))
(setq k (+ 1 k))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "cecolor"4 ".rectang" "_non" ptt1 ptt3)(setq elast (entlast));; boundary
(command "area" "O" "L")
(setq dt (* (getvar "area") tl tl 0.000001) tdt (+ tdt dt))
(setvar "CEColor" lacol)
(command "pline" "_non" PT P2 P5 P3 "C" "pline" "_non" P1 P4 "")
(wtxt_l (rtos k 2 0) P7 h)
(wtxt_l (rtos dt 2 2) P8 h)
(wtxt_l (rtos k 2 0) (mid elast) h)
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
);while
(setvar "DIMZIN" ladin)
(command "pline" "_non" P3 P9 P11 P5 "C" "pline" "_non" P10 P4 "")
(wtxt_l "Tæng" P12 h)
(wtxt_l (rtos tdt 2 2) P13 h)
(command "undo" "end")
(setvar "cmdecho" 1)
)

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#28 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 04 July 2011 - 04:31 PM

- 1,3 : OK
- 2 : nếu bạn chọn 4 điểm bất kỳ, chẳng may nó không là 4 điểm của 2 cạnh vuông góc thì bạn muốn tính DT theo kiểu gì đây, hay chỉ là chiều dài x chiều rộng và cũng không thiết phải tạo cho bạn cái preview như lisp đang làm ??? :)
Update cái mới dễ nhìn hơn :

(defun c:bdt(/ ptt1 ptt2 ptt3)
(defun wtxt_l(txt p h);;;Write txt on graphic screen at p
(entmake (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 40 h)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(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
)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" "_non" PT P2 P5 P3 "C" "pline" P1 P4 "")
(wtxt_l "% ¶ng thèng kª diÖn tÝch" P6 (* 1.2 h))
(wtxt_l "STT" P7 h)
(wtxt_l "DiÖn tÝch (m2)" P8 h)
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil))
(setq k (+ 1 k))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "cecolor"4 ".rectang" "_non" ptt1 ptt3)(setq elast (entlast));; boundary
(command "area" "O" "L")
(setq dt (* (getvar "area") tl tl 0.000001) tdt (+ tdt dt))
(setvar "CEColor" lacol)
(command "pline" "_non" PT P2 P5 P3 "C" "pline" "_non" P1 P4 "")
(wtxt_l (rtos k 2 0) P7 h)
(wtxt_l (rtos dt 2 2) P8 h)
(wtxt_l (rtos k 2 0) (mid elast) h)
(if (setq ptt1 (getpoint "\n Diem thu nhat canh 1 : "))(setq ptt2 (getpoint ptt1 "\n Diem thu 2 canh 1")))
(if ptt2 (setq ptt3 (getpoint ptt2 "\n Diem thu 2 canh 2 :")))
);while
(setvar "DIMZIN" ladin)
(command "pline" "_non" P3 P9 P11 P5 "C" "pline" "_non" P10 P4 "")
(wtxt_l "Tæng" P12 h)
(wtxt_l (rtos tdt 2 2) P13 h)
(command "undo" "end")
(setvar "cmdecho" 1)
)

2. Đúng rùi bác a. chỉ cần dài x rộng thôi, cái preview bỏ qua cũng đc, bác đánh đấu vùng đã làm bằng số như lisp cũ là ok a. vị trí số này theo e nên để ở trung điểm cạnh thứ 1.
- cái lisp sau e chạy đc 1 lần rùi nó báo:

Command: bdt

ty le ban ve < 1/1 >: 1/

Cao text < 500.00 >:

Chon diem xuat bang thong ke dien tich (mep trai):
Diem thu nhat canh 1 :
Diem thu 2 canh 1
Diem thu 2 canh 2 :; error: no function definition: VLAX-ENAME->VLA-OBJECT
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^

#29 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 July 2011 - 10:51 PM

2. Đúng rùi bác a. chỉ cần dài x rộng thôi, cái preview bỏ qua cũng đc, bác đánh đấu vùng đã làm bằng số như lisp cũ là ok a. vị trí số này theo e nên để ở trung điểm cạnh thứ 1.
- cái lisp sau e chạy đc 1 lần rùi nó báo:

Command: bdt

ty le ban ve < 1/1 >: 1/

Cao text < 500.00 >:

Chon diem xuat bang thong ke dien tich (mep trai):
Diem thu nhat canh 1 :
Diem thu 2 canh 1
Diem thu 2 canh 2 :; error: no function definition: VLAX-ENAME->VLA-OBJECT

Bạn nhớ lần sau nếu gặp lỗi tương tự (báo không có định nghĩa với hàm ..VL..) thì thêm dòng (vl-load-com) vào đầu lisp nhé :)
Code đây, bạn dùng tạm, mình k ưa nó lắm :(
(defun c:bdt(/ ptt1 ptt2 ptt3 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 ss )
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu (S\U+01A1n T\U+00F9ng)! ")
(defun wtxt_l(txt p h)
(entmake (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 40 h)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(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 ST:Entmake-Pline (list_pt Layer Color isClosed / Polylist)
(setq Polylist (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 8 Layer)
(cons 43 0)
(cons 62 Color)
(cons 90 (length list_pt))
(cons 70 (cond ((= isClosed T) 1)(T 0)))
)
Polylist (append Polylist (mapcar '(lambda (coord) (cons 10 coord)) list_pt)))
(entmakex PolyList)
)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq ladin (getvar "dimzin"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nT\U+1EC9 l\U+1EC7 : < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nChi\U+1EC1u cao text : < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0 ss (ssadd) tLay (getvar "clayer"))
(setvar "dimzin" 0)
(setq PT (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m xu\U+1EA5t b\U+1EA3ng th\U+1ED1ng k\U+00EA di\U+1EC7n t\U+00EDch (M\U+00E9p tr\U+00E1i) :"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(ST:Entmake-Pline (list PT P2 P5 P3) tLay 4 T)
(ST:Entmake-Pline (list P1 P4) tLay 4 Nil)
(wtxt_l "%%UB¶ng thèng kª diÖn tÝch" P6 (* 1.2 h))
(wtxt_l "STT" P7 h)
(wtxt_l "DiÖn tÝch (m2)" P8 h)
(if (setq ptt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 nh\U+1EA5t :"))(setq ptt2 (getpoint ptt1 "\n\n\U+0110i\U+1EC3m th\U+1EE9 hai :")))
(if (setq ptt3 (getpoint ptt2 "\n\U+0110i\U+1EC3m th\U+1EE9 ba :")) (setq ptt4 (getpoint ptt3 "\n\U+0110i\U+1EC3m th\U+1EE9 t\U+01B0 :")))
(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil)(/= ptt4 nil))
(setq k (+ 1 k))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq

(ST:Entmake-Pline (list ptt1 ptt2 ptt3 ptt4) tlay 4 T)
(setq elast (entlast));; boundary
(setq dt (* (distance ptt1 ptt2)(distance ptt3 ptt4) tl tl 0.000001) tdt (+ tdt dt))
(ssadd elast ss)
(ST:Entmake-Pline (list PT P2 P5 P3) tLay 4 T)
(ST:Entmake-Pline (list P1 P4) tLay 4 Nil)
(wtxt_l (rtos k 2 0) P7 h)
(wtxt_l (rtos dt 2 2) P8 h)
(wtxt_l (rtos k 2 0) (mid elast) h)(ssadd (entlast) ss)
(if (setq ptt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 nh\U+1EA5t :"))(setq ptt2 (getpoint ptt1 "\n\n\U+0110i\U+1EC3m th\U+1EE9 hai :")))
(if (setq ptt3 (getpoint ptt2 "\n\U+0110i\U+1EC3m th\U+1EE9 ba :")) (setq ptt4 (getpoint ptt3 "\n\U+0110i\U+1EC3m th\U+1EE9 t\U+01B0 :")))
);while
(setvar "DIMZIN" ladin)
(ST:Entmake-Pline (list P3 P9 P11 P5) tLay 4 T)
(ST:Entmake-Pline (list P10 P4) tLay 4 Nil)
(wtxt_l "Tæng" P12 h)
(wtxt_l (rtos tdt 2 2) P13 h)
(initget 1 "c k C K")
(if (setq ans (getkword " X\U+00F3a \U+0111\U+00E1nh d\U+1EA5u [C/K ] :?"))
(setq ans (strcase ans )))
(if (or (= ans "")(= ans nil)(= ans "C")) (command "erase" ss ""))
(command "undo" "end")
(setvar "cmdecho" 1)
)

  • 1

#30 tinya1225

tinya1225

    biết lệnh copy

  • Members
  • PipPipPip
  • 114 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 05 July 2011 - 08:51 AM

Bạn nhớ lần sau nếu gặp lỗi tương tự (báo không có định nghĩa với hàm ..VL..) thì thêm dòng (vl-load-com) vào đầu lisp nhé :)
Code đây, bạn dùng tạm, mình k ưa nó lắm :(

(defun c:bdt(/ ptt1 ptt2 ptt3 P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 ss )
(vl-load-com)
(grtext -1 "Free lisp from Cadviet @Ketxu (S\U+01A1n T\U+00F9ng)! ")
(defun wtxt_l(txt p h)
(entmake (list (cons 0 "TEXT") (cons 7 (getvar "textstyle")) (cons 40 h)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(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 ST:Entmake-Pline (list_pt Layer Color isClosed / Polylist)
(setq Polylist (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 8 Layer)
(cons 43 0)
(cons 62 Color)
(cons 90 (length list_pt))
(cons 70 (cond ((= isClosed T) 1)(T 0)))
)
Polylist (append Polylist (mapcar '(lambda (coord) (cons 10 coord)) list_pt)))
(entmakex PolyList)
)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq ladin (getvar "dimzin"))
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nT\U+1EC9 l\U+1EC7 : < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nChi\U+1EC1u cao text : < " (rtos h 2 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0 ss (ssadd) tLay (getvar "clayer"))
(setvar "dimzin" 0)
(setq PT (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m xu\U+1EA5t b\U+1EA3ng th\U+1ED1ng k\U+00EA di\U+1EC7n t\U+00EDch (M\U+00E9p tr\U+00E1i) :"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(ST:Entmake-Pline (list PT P2 P5 P3) tLay 4 T)
(ST:Entmake-Pline (list P1 P4) tLay 4 Nil)
(wtxt_l "% ¶ng thèng kª diÖn tÝch" P6 (* 1.2 h))
(wtxt_l "STT" P7 h)
(wtxt_l "DiÖn tÝch (m2)" P8 h)
(if (setq ptt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 nh\U+1EA5t :"))(setq ptt2 (getpoint ptt1 "\n\n\U+0110i\U+1EC3m th\U+1EE9 hai :")))
(if (setq ptt3 (getpoint ptt2 "\n\U+0110i\U+1EC3m th\U+1EE9 ba :")) (setq ptt4 (getpoint ptt3 "\n\U+0110i\U+1EC3m th\U+1EE9 t\U+01B0 :")))
(while (and (/= ptt1 nil)(/= ptt2 nil)(/= ptt3 nil)(/= ptt4 nil))
(setq k (+ 1 k))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq

(ST:Entmake-Pline (list ptt1 ptt2 ptt3 ptt4) tlay 4 T)
(setq elast (entlast));; boundary
(setq dt (* (distance ptt1 ptt2)(distance ptt3 ptt4) tl tl 0.000001) tdt (+ tdt dt))
(ssadd elast ss)
(ST:Entmake-Pline (list PT P2 P5 P3) tLay 4 T)
(ST:Entmake-Pline (list P1 P4) tLay 4 Nil)
(wtxt_l (rtos k 2 0) P7 h)
(wtxt_l (rtos dt 2 2) P8 h)
(wtxt_l (rtos k 2 0) (mid elast) h)(ssadd (entlast) ss)
(if (setq ptt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 nh\U+1EA5t :"))(setq ptt2 (getpoint ptt1 "\n\n\U+0110i\U+1EC3m th\U+1EE9 hai :")))
(if (setq ptt3 (getpoint ptt2 "\n\U+0110i\U+1EC3m th\U+1EE9 ba :")) (setq ptt4 (getpoint ptt3 "\n\U+0110i\U+1EC3m th\U+1EE9 t\U+01B0 :")))
);while
(setvar "DIMZIN" ladin)
(ST:Entmake-Pline (list P3 P9 P11 P5) tLay 4 T)
(ST:Entmake-Pline (list P10 P4) tLay 4 Nil)
(wtxt_l "Tæng" P12 h)
(wtxt_l (rtos tdt 2 2) P13 h)
(initget 1 "c k C K")
(if (setq ans (getkword " X\U+00F3a \U+0111\U+00E1nh d\U+1EA5u [C/K ] :?"))
(setq ans (strcase ans )))
(if (or (= ans "")(= ans nil)(= ans "C")) (command "erase" ss ""))
(command "undo" "end")
(setvar "cmdecho" 1)
)

Hề hề hề nó chạy ngon rùi bác a. Nhưng đúng là khó ưa thật^^. nhìn nó vẽ mấy cái đường thẳng bùn cười chít.
Bác chu đáo quá còn thêm vào phần xóa đánh dấu nữa^^
Em cám ơn bác nhiều a.
Chúc bác và cả nhà 1 ngày may mắn :D
  • 1
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^