Đến nội dung


Hình ảnh
- - - - -

[Help me] Cách lấy số liệu từ file txt


  • Please log in to reply
47 replies to this topic

#21 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 23 November 2011 - 02:54 PM

...
(or (setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))
...

Ket sửa lại dòng code trên chút xíu kẻo nó bắt nhập file hoặc chọn file hoài.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#22 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 November 2011 - 03:00 PM

Ket sửa lại dòng code trên chút xíu kẻo nó bắt nhập file hoặc chọn file hoài.


Tại sao thế bác nhỉ :)
  • 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


#23 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 23 November 2011 - 03:32 PM

Tại sao thế bác nhỉ :)

Ý là nếu dùng như thế thì hoặc file phải nằm trong thư mục "Support..." hoặc phải kèm Patt đầy đủ, còn nếu dùng
(if (or fn (setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))
thì không cần quan tâm vị trí của nó.
Mà thôi, cái này cũng tuỳ ý tưởng.
Thân thương!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#24 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 November 2011 - 03:40 PM

Ý là nếu dùng như thế thì hoặc file phải nằm trong thư mục "Support..." hoặc phải kèm Patt đầy đủ, còn nếu dùng
(if (or fn (setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))
thì không cần quan tâm vị trí của nó.
Mà thôi, cái này cũng tuỳ ý tưởng.
Thân thương!


"- Làm thế nào để khi mình chạy thì chuơng trình tự động chọn file txt luôn được ko ạ,chứ mỗi lần chạy lệnh lại phải chọn file txt em thấy cũng hơi bất tiện." (kedensau88)
+ Nếu trong máy người khác không có file ở đúng địa chỉ đó ?
=> Or.
Cái này là do yêu cầu của chính OP + bắt lỗi bác ạ.E nghĩ bác chưa test mà đoán nó là Getstring, hê hê ^^
  • 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


#25 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 23 November 2011 - 07:16 PM


"- Làm thế nào để khi mình chạy thì chuơng trình tự động chọn file txt luôn được ko ạ,chứ mỗi lần chạy lệnh lại phải chọn file txt em thấy cũng hơi bất tiện." (kedensau88)
+ Nếu trong máy người khác không có file ở đúng địa chỉ đó ?
=> Or.
Cái này là do yêu cầu của chính OP + bắt lỗi bác ạ.E nghĩ bác chưa test mà đoán nó là Getstring, hê hê ^^

Hề hề hề,
Cái nhà bác Ketxu này lắm mưu thiệt. E rằng chủ thớt chửa chắc hiểu cái mưu của bác nên...... không lười được.....
Hề hề hề,...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#26 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 November 2011 - 09:42 PM

Hề hề hề,
Cái nhà bác Ketxu này lắm mưu thiệt. E rằng chủ thớt chửa chắc hiểu cái mưu của bác nên...... không lười được.....
Hề hề hề,...

Chỉ cần set 1 lần, và e cũng vẫn để fn là global bác ơi :D
  • 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


#27 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 25 November 2011 - 10:32 AM

Bản DCL :

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"ANSI/ASME B16.47 FLANGES\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
) ;_ end of mapcar
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
) ;_ end of and
(progn
(start_list "NPS" 3)
(mapcar 'add_list lstType)
(end_list)
(action_tile "accept" "(setq ret (nth (atoi (get_tile \"NPS\")) lstType))(done_dialog)")
(start_dialog)
) ;_ end of progn
) ;_ end of if
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:test (/ PR RL lst typ)
;Dat ten file mac dinh
;Neu trong may k co ten file mac dinh, CT yeu cau chon file
(or fn
(setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))
;Doc du lieu tu file, xu ly
(if fn
(progn ; Neu doc duoc file fn nay
(setq PR (open fn "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst (append lst (list (list (car RL)(cdr RL))))
)
)
(close PR)
;Lay Type
(setq typ (atoi(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst))))
;Ve
(if (assoc typ lst)
(apply 'draw (cadr (assoc typ lst)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)

;Phan nay tro di la cua chu, tu chu chinh sua :
(defun draw ( D X G tsmall WT T1 A r1 C D1 / OldOS P1) ;Nho set tat ca bien P1 -> 30 o day
(setq P1(getpoint "\n Start Point:")
P2(polar P1 pi G)
P3(polar P2 (* pi 1.5) 6.35)
P4(polar P3 pi (/(- D G) 2))
P5(polar P4 (* pi 1.5) tsmall)
P6(polar P5 0.0 (/(- D X) 2))
P7 (list (+ (car P6) (/ (- X A) 2)) (- (cadr P6) (- T1 tsmall)) (caddr p6))
P8(polar P7 0.0 A)
P9(list (+ (car P8) (/ (- X A) 2)) (+ (cadr P8) (- T1 tsmall)) (caddr p8))
P10(polar P9 0.0 (/(- D X) 2))
P11(polar P10 (/ pi 2) tsmall)
P12(polar P11 pi (/(- D G) 2))
P13(polar P1 pi (/(- G (- A (* WT 2))) 2))
P14(polar P13 (* pi 1.5) (+ T1 6.35))
P15(polar P13 pi (- A (* WT 2)))
P16(polar P15 (* pi 1.5) (+ T1 6.35))
P17(polar P3 pi (/(- C G D1) 2))
P18(polar P17 (* pi 1.5) tsmall)
P19(polar P17 pi D1)
P20(polar P19 (* pi 1.5) tsmall)
P21(polar P12 0.0 (/(- C G D1) 2))
P22(polar P21 (* pi 1.5) tsmall)
P23(polar P21 0.0 D1)
P24(polar P23 (* pi 1.5) tsmall)
P25(list (- (car P24) (/ D1 2)) (- (cadr P24) 10) (caddr p24))
P26(polar P25 (* pi 0.5) (+ tsmall 20))
P27(list (- (car P8) (/ A 2)) (- (cadr P8) 15) (caddr p8))
P28(polar P27 (* pi 0.5) (+ T1 36.35))
P29(list (- (car P18) (/ D1 2)) (- (cadr P18) 10) (caddr p18))
P30(polar P29 (* pi 0.5) (+ tsmall 20))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "line" P1 P2 P3 P4 P5 "")
(command "line" P5 P6 "")
(setq A1 (entlast))
(command "line" P6 P7 "")
(setq B1 (entlast))
(command "line" P7 P8 "")
(command "line" P8 P9 "")
(setq C1 (entlast))
(command "line" P9 P10 "")
(setq D1 (entlast))
(command "line" P10 P11 P12 p1 "")
(command "line" P13 P14 "")
(command "line" P15 P16 "")
(command "line" P17 P18 "")
(command "line" P19 P20 "")
(command "line" P21 P22 "")
(command "line" P23 P24 "")
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER2" "" "")
(command "line" P25 P26 "")
(command "line" P27 P28 "")
(command "line" P29 P30 "")
(command "fillet" "r" r1 "" "fillet" A1 B1 )
(command "fillet" "" "fillet" C1 D1 )
(command "zoom" "w" P26 P29)
(setvar "osmode" OldOs)
(princ)
)

  • 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


#28 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 December 2011 - 11:13 PM

Các anh ơi cho em hỏi,em có 1 chương trình vẽ Elbowls45 như thế này :

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq mylist (list "Elbowls 45" "Elbowls 90" "Elbowls 180"))
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(start_list "NPS" 3)
(mapcar 'add_list lstType)
(end_list)
(start_list "mylist" 3)
(mapcar 'add_list mylist)
(end_list)
(action_tile "accept" "(setq ret (nth (atoi (get_tile \"NPS\")) lstType))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:e45 (/ PR RL )
(setq lst nil typ nil)
(or fn
(setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn
(progn
(setq PR (open fn "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst (append lst (list (list (car RL)(cdr RL))))
)
)
(close PR)
(setq typ (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst))))
(if (assoc typ lst)
(apply 'draw (cadr (assoc typ lst)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;--------------------------------------------------------------------------------
(defun draw (OD B / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
(setvar "osmode" OldOs)
(princ)
)

Bây giờ em muốn thêm 2 chương trình vẽ Elbowls90 và Elbowls180 vào chương trình trên mà để dc như cái Dialog(như hình vẽ) mà khi mình chọn loại Elbowls để vẽ thì nó sẽ vẽ dc Elbowls đó với các số liệu tương ứng thì em phải làm thế nào ạ.
Hình đã gửi
Mong các anh giúp đỡ.Còn các chương trình Elbowls90,Elbowls180 và các số liệu tương ứng nằm trong tệp này ạ :
Download Elbowls.zip with Mup5
Em xin chân thành cảm ơn các anh nhiều.
  • 0

#29 thichhoabinh

thichhoabinh

    biết vẽ circle

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

Đã gửi 05 December 2011 - 12:49 PM

OP không nghiền ngẫm các action_tile đã được ketxu viết bên trên thì yêu cầu đến bao giờ hết ??
1. Việc đầu tiên : chuyển hết 2 defun C: của 90,180 thành dạng hàm giống draw (draw90, draw 180).
Vì 3 hàm vẽ này có chung số lượng đối số nên viết khá giống nhau, và khi sử dụng cũng dùng apply
2. Tạo list tương ứng với loại elbowls.
Cách đọc dữ liệu lấy vào biến lst đã có, giờ chỉ cần thêm 1 thao tác gán loại elbowls vào đầu để tạo thành assoc list, tiện cho việc lấy ra
3. Tạo Action khi click vào listbox để xuất ra list NPS tương ứng
4. Tạo Action khi nhấn OK (sử dụng hàm tương ứng với loại elbow đã chọn)

=> Bạn vướng ở chỗ nào để mọi người cùng giúp ??
  • 2

#30 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 December 2011 - 02:04 PM

Em còn vướng ở bước 3 và 4,mong anh giúp đỡ.
  • 0

#31 thichhoabinh

thichhoabinh

    biết vẽ circle

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

Đã gửi 05 December 2011 - 02:10 PM

Thế bước 1,2 của bạn đâu :) Phải quy định kiểu dữ liệu list lấy ra như thế nào thì mới biết cách thao tác với nó chứ ?
  • 0

#32 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 December 2011 - 06:54 PM

Thế bước 1,2 của bạn đâu :) Phải quy định kiểu dữ liệu list lấy ra như thế nào thì mới biết cách thao tác với nó chứ ?

Bước 1,2 của em làm như thế này đúng chưa anh :mellow:

(defun DCL ( lstType / fl ret dcl_id Return# )
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq mylist (list "Elbowls 45" "Elbowls 90" "Elbowls 180"))
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(start_list "NPS" 3)
(mapcar 'add_list lstType)
(end_list)
(start_list "mylist" 3)
(mapcar 'add_list mylist)
(end_list)
(action_tile "accept" "(setq ret (nth (atoi (get_tile \"NPS\")) lstType))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e45 (/ PR RL )
(setq lst nil typ nil)
(or fn
(setq fn (findfile "Nhap ten file mac dinh vao day"))
(setq fn (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn
(progn
(setq PR (open fn "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst (append lst (list (list (car RL)(cdr RL))))
)
)
(close PR)
(setq typ (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst))))
(if (assoc typ lst)
(apply 'draw (cadr (assoc typ lst)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e90 (/ PR1 RL1 )
(setq lst1 nil typ1 nil)
(or fn1
(setq fn1 (findfile "Nhap ten file mac dinh vao day"))
(setq fn1 (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn1
(progn
(setq PR1 (open fn1 "r") RL1 (read-line PR1))
(while (setq RL1 (read-line PR1))
(setq RL1 (read (strcat "(" RL1 ")"))
lst1 (append lst1 (list (list (car RL1)(cdr RL1))))
)
)
(close PR1)
(setq typ1 (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst1))))
(if (assoc typ1 lst1)
(apply 'draw1 (cadr (assoc typ1 lst1)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:e180 (/ PR2 RL2 )
(setq lst2 nil typ2 nil)
(or fn2
(setq fn2 (findfile "Nhap ten file mac dinh vao day"))
(setq fn2 (getfiled "Chon file chua so lieu" "" "txt" 2)))

(if fn2
(progn
(setq PR2 (open fn2 "r") RL2 (read-line PR2))
(while (setq RL2 (read-line PR2))
(setq RL2 (read (strcat "(" RL2 ")"))
lst2 (append lst2 (list (list (car RL2)(cdr RL2))))
)
)
(close PR2)
(setq typ2 (read(DCL (mapcar '(lambda (x)(vl-princ-to-string (car x))) lst2))))
(if (assoc typ2 lst2)
(apply 'draw2 (cadr (assoc typ2 lst2)))
(and (princ "\nMissed Type")(exit))
)
)
(princ "\nMissed File")
)
)
;--------------------------------------------------------------------------------
(defun draw (OD B / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
(setvar "osmode" OldOs)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun draw1 (OD A / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")
P2(polar P1 (/ pi 2) A)
P3(polar P2 (* pi 1.5) (/ OD 2))
P4(polar P2 (/ pi 2) (/ OD 2))
P5(polar P1 pi (+ A (/ OD 2)))
P6(list (+ (car P1) (+ A (/ OD 2))) (- (cadr P1) (+ A (/ OD 2))) (caddr P1))
P7(list (- (car P1) (/ A 4)) (+ (cadr P1) (/ A 4)) (caddr P1))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P1 P4 "")
(command "line" P1 P5 "")
(command "zoom" "w" P6 P4)
(command "TRIM" "" P6 P7 "")
(setvar "osmode" OldOs)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun draw2 (OD O / P1 P2 P3 P4 P5 P6 P7 OldOS)
(setq
P1(getpoint "\n Start Point:")

P2(polar P1 pi (* O 0.5))
P3(polar P2 0.0 (* OD 0.5))
P4(polar P2 pi (* OD 0.5))
P5(polar P1 0.0 (* 0.5 (+ O OD)))
P6(list (+ (car P1) (* 1 O)) (- (cadr P1) (* O 1)) (caddr P1))
P7(list (- (car P1) (* 0.25 (- O OD))) (+ (cadr P1) (* 0.25 (- O OD))) (caddr P1))
P8(list (- (car P1) (* 1 O)) (+ (cadr P1) (* O 1)) (caddr P1))
)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P4 P5 "")
(command "zoom" "w" P6 P8)
(command "trim" "" P6 P7 "")
(setvar "osmode" OldOs)
(princ)
)

  • 0

#33 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 December 2011 - 10:53 PM

Đúng là bạn chưa hiểu ra vấn đề mà chỉ copy paste thôi....
  • 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


#34 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 December 2011 - 07:34 AM

Vâng,em cũng nói thật với các anh,em mới học viết lisp nên cũng chưa hiểu nhiều lắm.
Các anh viết nốt cho em chuơng trình này thôi rồi lần sau em sẽ tự nghiên cứu và tìm hiểu ạ,bây giờ em đang cần gấp chuơng trình này,các anh giúp em với ạ.
Em xin chân thành cảm ơn nhiều !!!!
  • 0

#35 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 December 2011 - 09:58 AM


(defun DCL ( lstType / fl ret dcl_id Return# add_lst tmp)
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(add_lst "mylist" '("Elbowls 45" "Elbowls 90" "Elbowls 180") 3)
(set_tile "mylist" "0")
(add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3) ;Chu y dong khoi tao lay du lieu Elbowls 45
;Xu ly khi pick chon loai Elbowls
(action_tile "mylist"
"(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
)
(action_tile "accept" "(setq ret (list (get_tile \"mylist\")
(car (setq tmp
(cadr
(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))))
(last tmp)
))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:ef (/ PR RL lst0 lst1 lst2 lst val pt)

;Lay ten file
(or fn0
(setq fn0 (findfile "Nhap ten file mac dinh vao day"))
(setq fn0 (getfiled "Chon file chua so lieu Elbowls 45 " "" "txt" 2)))
(or fn1
(setq fn1 (findfile "Nhap ten file mac dinh vao day"))
(setq fn1 (getfiled "Chon file chua so lieu Elbowls 90 " "" "txt" 2)))
(or fn2
(setq fn2 (findfile "Nhap ten file mac dinh vao day"))
(setq fn2 (getfiled "Chon file chua so lieu Elbowls 180 " "" "txt" 2)))
;Het lay ten file
(if (and fn0 fn1 fn2)
(progn
; Doc tung file dua vao list
(setq PR (open fn0 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst0 (append lst0 (list (list (car RL)(cdr RL))))
)
)
(setq lst0 (list "0" lst0))
(close PR)
; Doc file fn1 dua vao list
(setq PR (open fn1 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst1 (append lst1 (list (list (car RL)(cdr RL))))
)
)
(setq lst1 (list "1" lst1))
(close PR)
(setq PR (open fn2 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst2 (append lst2 (list (list (car RL)(cdr RL))))
)
)
(setq lst2 (list "2" lst2))
(close PR)
(setq lst (list lst0 lst1 lst2)) ;Lay list du lieu dang (("0" (NPS (OD B))(NPS (OD B))...)("1" (NPS (OD B))(NPS (OD B))...)...)
(if
(and (setq val (DCL lst))
(setq pt (getpoint "\nDiem chen:"))
)
(apply 'draw (append val (list pt)))
(princ "Loi")
)
);Het Progn
(princ "\nThieu file")
)
(princ)
)


;--------------------------------------------------------------------------------
(defun draw (Loai OD B P1 / P2 P3 P4 P5 P6 P7 OldOS)
;Phan nay la phan chung cua tat ca cac ham
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(cond
((= Loai "0") ;Loai 45 do
(setq
P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
) ;Ket thuc ham ve Loai 45
((= Loai "1") ;Loai 90
(setq
P2(polar P1 (/ pi 2) B)
P3(polar P2 (* pi 1.5) (/ OD 2))
P4(polar P2 (/ pi 2) (/ OD 2))
P5(polar P1 pi (+ B (/ OD 2)))
P6(list (+ (car P1) (+ B (/ OD 2))) (- (cadr P1) (+ B (/ OD 2))) (caddr P1))
P7(list (- (car P1) (/ B 4)) (+ (cadr P1) (/ B 4)) (caddr P1))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P1 P4 "")
(command "line" P1 P5 "")
(command "zoom" "w" P6 P4)
(command "TRIM" "" P6 P7 "")
) ;Ket thuc ham ve loai 90

((= Loai "2")
(setq
P2(polar P1 pi (* O 0.5))
P3(polar P2 0.0 (* OD 0.5))
P4(polar P2 pi (* OD 0.5))
P5(polar P1 0.0 (* 0.5 (+ O OD)))
P6(list (+ (car P1) (* 1 O)) (- (cadr P1) (* O 1)) (caddr P1))
P7(list (- (car P1) (* 0.25 (- O OD))) (+ (cadr P1) (* 0.25 (- O OD))) (caddr P1))
P8(list (- (car P1) (* 1 O)) (+ (cadr P1) (* O 1)) (caddr P1))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P4 P5 "")
(command "zoom" "w" P6 P8)
(command "trim" "" P6 P7 "")
) ; Ket thuc ham ve loai 180
);Ket thuc phan loai COnd
;Phan nay la phan chung
(setvar "osmode" OldOs)
(princ)
)
Code đa số mình dùng dotted pair list chứ k phân ra nhiều biến và lợi dụng hàm assoc, bạn phải chú ý theo dõi sự thay đổi của các biến nhận về thì mới hiểu rõ được. Hiện tại mình chưa rỗi nên chưa viết rõ chức năng từng dòng được, nên bạn chịu khó ngâm, khúc mắc đâu mọi người sẽ giải thích

Phần lấy tên 3 file và đọc dữ liệu trong từng file gán vào 1 list nhỏ mình cố ý để dài như vậy để bạn hiểu nhược điểm bất tiện của nó khi code : số lượng file chứa Elbowls là cố định và k linh hoạt. Bạn hãy sửa thành cách cho chọn bất kỳ file Elbowls nào (thêm 1 nút chọn thêm file) => append file vào list các loại elbowls
(Lấy tên loại elbowls = tên file - *.txt). COi như đây là 1 bài tập dành cho bạn (nếu bạn thực sự muốn chương trình của mình tốt hơn)
  • 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


#36 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 07 December 2011 - 08:00 PM


(defun DCL ( lstType / fl ret dcl_id Return# add_lst tmp)
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(add_lst "mylist" '("Elbowls 45" "Elbowls 90" "Elbowls 180") 3)
(set_tile "mylist" "0")
(add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3) ;Chu y dong khoi tao lay du lieu Elbowls 45
;Xu ly khi pick chon loai Elbowls
(action_tile "mylist"
"(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
)
(action_tile "accept" "(setq ret (list (get_tile \"mylist\")
(car (setq tmp
(cadr
(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))))
(last tmp)
))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:ef (/ PR RL lst0 lst1 lst2 lst val pt)

;Lay ten file
(or fn0
(setq fn0 (findfile "Nhap ten file mac dinh vao day"))
(setq fn0 (getfiled "Chon file chua so lieu Elbowls 45 " "" "txt" 2)))
(or fn1
(setq fn1 (findfile "Nhap ten file mac dinh vao day"))
(setq fn1 (getfiled "Chon file chua so lieu Elbowls 90 " "" "txt" 2)))
(or fn2
(setq fn2 (findfile "Nhap ten file mac dinh vao day"))
(setq fn2 (getfiled "Chon file chua so lieu Elbowls 180 " "" "txt" 2)))
;Het lay ten file
(if (and fn0 fn1 fn2)
(progn
; Doc tung file dua vao list
(setq PR (open fn0 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst0 (append lst0 (list (list (car RL)(cdr RL))))
)
)
(setq lst0 (list "0" lst0))
(close PR)
; Doc file fn1 dua vao list
(setq PR (open fn1 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst1 (append lst1 (list (list (car RL)(cdr RL))))
)
)
(setq lst1 (list "1" lst1))
(close PR)
(setq PR (open fn2 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst2 (append lst2 (list (list (car RL)(cdr RL))))
)
)
(setq lst2 (list "2" lst2))
(close PR)
(setq lst (list lst0 lst1 lst2)) ;Lay list du lieu dang (("0" (NPS (OD B))(NPS (OD B))...)("1" (NPS (OD B))(NPS (OD B))...)...)
(if
(and (setq val (DCL lst))
(setq pt (getpoint "\nDiem chen:"))
)
(apply 'draw (append val (list pt)))
(princ "Loi")
)
);Het Progn
(princ "\nThieu file")
)
(princ)
)


;--------------------------------------------------------------------------------
(defun draw (Loai OD B P1 / P2 P3 P4 P5 P6 P7 OldOS)
;Phan nay la phan chung cua tat ca cac ham
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(cond
((= Loai "0") ;Loai 45 do
(setq
P2(polar P1 0.0 (* B 2.414213562))
P3(polar P1 0.0 (* OD 0.5))
P4(polar P1 pi (* OD 0.5))
P5(list (- (car P2) (/ (* B (atan 67.5)) 4)) (- (cadr P2) 10) (caddr P2))
P6(list (- (car P2) (/ (* B (atan 67.5)) 4)) (+ (cadr P2) 10) (caddr P2))
P7(list (- (car P2) (* OD 0.5)) (- (cadr P2) (+ OD (* B 2.414213562))) (caddr P2))
P8(polar P2 (/ pi 2) (+ OD (* B 2.414213562)))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P2 P1)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P2 P3)
(command "circle" P2 P4)
(command "line" P2 P4 "")
(command "rotate" "b" P5 P6 "" P2 -45 "")
(command "line" P2 P4 "")
(command "zoom" "w" P7 P8)
(command "trim" "" P7 P8 "")
) ;Ket thuc ham ve Loai 45
((= Loai "1") ;Loai 90
(setq
P2(polar P1 (/ pi 2) B)
P3(polar P2 (* pi 1.5) (/ OD 2))
P4(polar P2 (/ pi 2) (/ OD 2))
P5(polar P1 pi (+ B (/ OD 2)))
P6(list (+ (car P1) (+ B (/ OD 2))) (- (cadr P1) (+ B (/ OD 2))) (caddr P1))
P7(list (- (car P1) (/ B 4)) (+ (cadr P1) (/ B 4)) (caddr P1))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P1 P4 "")
(command "line" P1 P5 "")
(command "zoom" "w" P6 P4)
(command "TRIM" "" P6 P7 "")
) ;Ket thuc ham ve loai 90

((= Loai "2")
(setq
P2(polar P1 pi (* O 0.5))
P3(polar P2 0.0 (* OD 0.5))
P4(polar P2 pi (* OD 0.5))
P5(polar P1 0.0 (* 0.5 (+ O OD)))
P6(list (+ (car P1) (* 1 O)) (- (cadr P1) (* O 1)) (caddr P1))
P7(list (- (car P1) (* 0.25 (- O OD))) (+ (cadr P1) (* 0.25 (- O OD))) (caddr P1))
P8(list (- (car P1) (* 1 O)) (+ (cadr P1) (* O 1)) (caddr P1))
)
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER" "" "")
(command "circle" P1 P2)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "circle" P1 P3)
(command "circle" P1 P4)
(command "line" P4 P5 "")
(command "zoom" "w" P6 P8)
(command "trim" "" P6 P7 "")
) ; Ket thuc ham ve loai 180
);Ket thuc phan loai COnd
;Phan nay la phan chung
(setvar "osmode" OldOs)
(princ)
)
Code đa số mình dùng dotted pair list chứ k phân ra nhiều biến và lợi dụng hàm assoc, bạn phải chú ý theo dõi sự thay đổi của các biến nhận về thì mới hiểu rõ được. Hiện tại mình chưa rỗi nên chưa viết rõ chức năng từng dòng được, nên bạn chịu khó ngâm, khúc mắc đâu mọi người sẽ giải thích

Phần lấy tên 3 file và đọc dữ liệu trong từng file gán vào 1 list nhỏ mình cố ý để dài như vậy để bạn hiểu nhược điểm bất tiện của nó khi code : số lượng file chứa Elbowls là cố định và k linh hoạt. Bạn hãy sửa thành cách cho chọn bất kỳ file Elbowls nào (thêm 1 nút chọn thêm file) => append file vào list các loại elbowls
(Lấy tên loại elbowls = tên file - *.txt). COi như đây là 1 bài tập dành cho bạn (nếu bạn thực sự muốn chương trình của mình tốt hơn)

Hic,hic,khó quá anh ơi,em chịu thôi ạ. :(
  • 0

#37 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 December 2011 - 10:28 PM

Thế thì bạn cứ dùng như vậy thôi :)
  • 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


#38 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2011 - 12:20 PM

Thế thì bạn cứ dùng như vậy thôi :)


Anh ơi cho em hỏi có phải chương trình trên bị giới hạn số biến là 3 (NPS, OD, B ) phải ko anh ??
Em thử thay 1 chương trình khác vào với số biến lớn hơn và mặc dù đã khai báo thêm biến ở hàm draw rồi mà nó vẫn báo lỗi này là sao vậy anh :"error: too few arguments"
  • 0

#39 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 08 December 2011 - 01:41 PM


Anh ơi cho em hỏi có phải chương trình trên bị giới hạn số biến là 3 (NPS, OD, B ) phải ko anh ??
Em thử thay 1 chương trình khác vào với số biến lớn hơn và mặc dù đã khai báo thêm biến ở hàm draw rồi mà nó vẫn báo lỗi này là sao vậy anh :"error: too few arguments"


Đỏ: không có chuyện giới hạn 3 biến đâu. Bạn muốn khai thêm/bớt là tuỳ thôi.
Xanh: lỗi này có thể là 1 hàm nào đó (hàm gốc của lisp hay hàm do bạn viết) y/c số biến là N nhưng bạn lại dùng nó với số biến là M<N.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#40 kedensau88

kedensau88

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2011 - 02:20 PM

Anh xem giúp cho em chương trình này.Em vẫn giữ nguyên hàm của anh ketxu,em chỉ thay cái hàm tính ebows45 bằng 1 hàm khác có nhiều biến hơn là nó báo lỗi.

(defun DCL ( lstType / fl ret dcl_id Return# add_lst tmp)
(defun add_lst (key lst method)
(start_list key method)
(mapcar 'add_list lst)
(end_list)
)
(vl-load-com)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar
'(lambda (x) (write-line x ret))
(list
" mip_msg : dialog { label = \"Elbowls\";"
" : boxed_column { label = \"Chon loai Elbowls\";"
" : list_box { key = \"mylist\";width = 17;}"
" } "
" : boxed_column { label = \"Chon loai NPS\";"
" : popup_list {key = \"NPS\"; width = 17; height = 8;} "
" } "
" : row { "
" : button {label = \"OK\"; key = \"accept\"; width = 10; fixed_width = true;} "
" : button {label = \"Cancel\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}"
" } "
"} "
)
)
(setq ret (close ret))
(if (and (not (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
)
(progn
(add_lst "mylist" '("Elbowls 45" "Elbowls 90" "Elbowls 180") 3)
(set_tile "mylist" "0")
(add_lst "NPS" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadadr lst)) 3)
;Xu ly khi pick chon loai Elbowls
(action_tile "mylist"
"(add_lst \"NPS\" (mapcar '(lambda (x)(vl-princ-to-string (car x))) (cadr (assoc $value lst))) 3)"
)
(action_tile "accept" "(setq ret (list (get_tile \"mylist\")
(car (setq tmp
(cadr
(nth (atoi (get_tile \"NPS\")) (cadr (assoc (get_tile \"mylist\") lst))))))
(last tmp)
))(done_dialog)")
(start_dialog)
)
)
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
)

(defun c:eb (/ PR RL lst0 lst1 lst2 lst val pt)

;Lay ten file
(or fn0
(setq fn0 (findfile "Nhap ten file mac dinh vao day"))
(setq fn0 (getfiled "Chon file chua so lieu Elbowls 45 " "" "txt" 2)))
(or fn1
(setq fn1 (findfile "Nhap ten file mac dinh vao day"))
(setq fn1 (getfiled "Chon file chua so lieu Elbowls 90 " "" "txt" 2)))
(or fn2
(setq fn2 (findfile "Nhap ten file mac dinh vao day"))
(setq fn2 (getfiled "Chon file chua so lieu Elbowls 180 " "" "txt" 2)))
;Het lay ten file
(if (and fn0 fn1 fn2)
(progn
; Doc tung file dua vao list
(setq PR (open fn0 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst0 (append lst0 (list (list (car RL)(cdr RL))))
)
)
(setq lst0 (list "0" lst0))
(close PR)
; Doc file fn1 dua vao list
(setq PR (open fn1 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst1 (append lst1 (list (list (car RL)(cdr RL))))
)
)
(setq lst1 (list "1" lst1))
(close PR)
(setq PR (open fn2 "r") RL (read-line PR))
(while (setq RL (read-line PR))
(setq RL (read (strcat "(" RL ")"))
lst2 (append lst2 (list (list (car RL)(cdr RL))))
)
)
(setq lst2 (list "2" lst2))
(close PR)
(setq lst (list lst0 lst1 lst2))
(if
(and (setq val (DCL lst))
(setq pt (getpoint "\nDiem chen:"))
)
(apply 'draw (append val (list pt)))
(princ "Loi")
)
);Het Progn
(princ "\nThieu file")
)
(princ)
)


;----EM THAY CHUONG TRINH KHAC VAO DAY--------------------------------
(defun draw (Loai D X G tsmall WT T1 A r1 C D1 P1 / OldOS)
(setq OldOs(getvar "osmode"))
(setvar "osmode" 0)
(cond
((= Loai "0")
(setq
P2(polar P1 pi G)
P3(polar P2 (* pi 1.5) 6.35)
P4(polar P3 pi (/(- D G) 2))
P5(polar P4 (* pi 1.5) tsmall)
P6(polar P5 0.0 (/(- D X) 2))
P7 (list (+ (car P6) (/ (- X A) 2)) (- (cadr P6) (- T1 tsmall)) (caddr p6))
P8(polar P7 0.0 A)
P9(list (+ (car P8) (/ (- X A) 2)) (+ (cadr P8) (- T1 tsmall)) (caddr p8))
P10(polar P9 0.0 (/(- D X) 2))
P11(polar P10 (/ pi 2) tsmall)
P12(polar P11 pi (/(- D G) 2))
P13(polar P1 pi (/(- G (- A (* WT 2))) 2))
P14(polar P13 (* pi 1.5) (+ T1 6.35))
P15(polar P13 pi (- A (* WT 2)))
P16(polar P15 (* pi 1.5) (+ T1 6.35))
P17(polar P3 pi (/(- C G D1) 2))
P18(polar P17 (* pi 1.5) tsmall)
P19(polar P17 pi D1)
P20(polar P19 (* pi 1.5) tsmall)
P21(polar P12 0.0 (/(- C G D1) 2))
P22(polar P21 (* pi 1.5) tsmall)
P23(polar P21 0.0 D1)
P24(polar P23 (* pi 1.5) tsmall)
P25(list (- (car P24) (/ D1 2)) (- (cadr P24) 10) (caddr p24))
P26(polar P25 (* pi 0.5) (+ tsmall 20))
P27(list (- (car P8) (/ A 2)) (- (cadr P8) 15) (caddr p8))
P28(polar P27 (* pi 0.5) (+ T1 36.35))
P29(list (- (car P18) (/ D1 2)) (- (cadr P18) 10) (caddr p18))
P30(polar P29 (* pi 0.5) (+ tsmall 20))
)
(COMMAND "LAYER" "M" "3" "C" "3" "" "L" "CONTINUOUS" "" "")
(command "line" P1 P2 P3 P4 P5 "")
(command "line" P5 P6 "")
(setq A1 (entlast))
(command "line" P6 P7 "")
(setq B1 (entlast))
(command "line" P7 P8 "")
(command "line" P8 P9 "")
(setq C1 (entlast))
(command "line" P9 P10 "")
(setq D1 (entlast))
(command "line" P10 P11 P12 p1 "")
(command "line" P13 P14 "")
(command "line" P15 P16 "")
(command "line" P17 P18 "")
(command "line" P19 P20 "")
(command "line" P21 P22 "")
(command "line" P23 P24 "")
(COMMAND "LAYER" "M" "1" "C" "1" "" "L" "CENTER2" "" "")
(command "line" P25 P26 "")
(command "line" P27 P28 "")
(command "line" P29 P30 "")
(command "fillet" "r" r1 "" "fillet" A1 B1 )
(command "fillet" "" "fillet" C1 D1 )
(command "zoom" "w" P26 P29)
)
);Ket thuc phan loai COnd
;Phan nay la phan chung
(setvar "osmode" OldOs)
(princ)
)

  • 0