Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#761 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 19 January 2010 - 08:10 PM

Xin cảm ơn bạn ! Lisp chạy rất tốt. Bạn có thể bổ sung giúp mình trả về kết quả ở dạng danh sách với cấu trúc ((TAG_NAME1 . VAL_TAG1) (TAG_NAME2 . VAL_TAG2)...) để giúp cho quá trình xử lý tiếp sau được thuận lợi hơn.
Xin chân thành cảm ơn !!!

Bạn xem đoạn lisp sau đây, mình đã bổ sung theo yêu cầu của bạn. Không biết đã đúng chưa, bạn chạy thử nhé.

(defun c:gtb ()
(if (setq ent(entsel "\n Select a Block: ")) ;- Let the user select a block (Chọn block)
(progn
(setq en(car ent)) ;- Get the entity name of the block (lấy tên đối tượng của block)
(setq enlist(entget en)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
(setq blkType(cdr(assoc 0 enlist))) ;- Save the type of entity (lưu lại loại đối tượng)
(if (= blkType "INSERT") ;- If the entity type is an Insert entity
;(nếu loại đối tượng là đối tượng Insert)
(progn
(if(= (cdr(assoc 66 enlist)) 1) ;- See if the attribute flag equals one (if so, attributes follow)
;(Kiểm tra flag thuộc tính )
(progn
(setq en2(entnext en)) ;- Get the next sub-entity (lấy đối tượng phụ tiếp theo)
(setq enlist2(entget en2)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
(setq attvallst (list))
(setq atttaglst (list))
(setq attlst (list))
(while (/= (cdr(assoc 0 enlist2)) "SEQEND") ;- Start the while loop and keep
;- looping until SEQEND is found.
;(Lặp trong khi loại đối tượng không phải SEQEND)
(setq attval (cdr (assoc 1 enlist2))
attvallst (append attvallst (list attval)))
(setq atttag (cdr (assoc 2 enlist2))
atttaglst (append atttaglst (list atttag)))
(setq att (cons atttag attval)
attlst (append attlst (list att)))
(princ "\n ") ;-Print a new line (tạo dòng kết quả mới)
(princ attvallst) ;- Print the attribute value (in ra các gia trị thuộc tính)
(princ "\n")
(princ atttaglst)
(princ "/n")
(princ attlst)
(setq en2(entnext en2)) ;- Get the next sub-entity (lấy đối tượng phụ tiếp theo)
(setq enlist2(entget en2)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
) ; Kết thúc hàm while
) ; Kết thúc hàm thông báo progn lần thứ 3
) ;- Close the if group code 66 = 1 statement (Đóng hàm if kiểm tra mã nhóm 66 )
) ; Kết thúc hàm thông báo progn lần thứ 2
) ;- Close the if block type = "ATTRIB" statement (Đóng hàm if kiểm tra loại đối tượng)
) ; Đóng thông báo progn lần thứ nhất
) ;- Close the if an Entity is selected statement (Đóng hàm if kiểm tra việc chọn đối tượng)
)

Có thể kết quả in ra là thừa so với yêu cầu của bạn, nếu vậy những cái thừa bạn có thể lược bớt nhé. Chỉ cần xóa dòng code (princ "các kết quả thừa đi") bạn ạ
Ví dụ bạn muốn bỏ cái list của các giá trị thuộc tính thì bạn xóa dòng code (princ attvallst).
Trong đoạn lisp trên thực ra bạn có thể đưa các lệnh in kết quả ra sau vòng lặp while vì có thể chả cần in chúng ra giữa chừng khi chưa chạy xong làm chi. Tuy nhiên nếu để như vậy thì khi bạn chạy debug sẽ dễ phát hiện lỗi hơn.
Lisp này là mình mót được của cụ Jeffy Sanders rồi sửa lại tí chút thôi mà.
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#762 t3pubt

t3pubt

    biết pan

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

Đã gửi 19 January 2010 - 08:11 PM

MÌNH CÓ Ý TƯỞNG THẾ NÀY
CÔNG VIỆC : TÍNH KHỐI LƯỢNG ĐÀO ĐẮP
BẢN EXCEL NHƯ SAU
LYTRINH KCACH S ĐÀO S ĐẮP V ĐÀO V ĐẮP
LẤY TỪ NTD LẤY TỪ NTD

PHẦN S ĐÀO TA DÙNG LỆNH Q CHỌN VÙNG POLYLINE KÍN TRONG CAD THEO THỨ TỰ CỦA LÝ TRÌNH TRONG TRẮC NGANG NOVA.THONG TIN S ĐÀO XUẤT RA EXECL HAY TXT THEO THỨ TỰ NHƯ SAU
TT DT
1 KQDT
2 KQDT
3 KQDT
...
SAU ĐÓ TA GHÉP HAI BẢNG EXCEL LẠI LÀ CÓ ĐƯỢC V ĐÀO

KHÔNG BIẾT CÁC BẠN GIÚP ĐƯỢC MÌNH KHÔNG ,CHỨ MÌNH NGỒI NHẬP TỪ CỌC TRẮC NGANG 1 TỪ CAD QUA BẢN EXCEL LÂU QUÁ
http://www.cadviet.c...pfiles/2/b1.jpg
MÌNH CÓ PHẦN AUTOLIT TÍNH DT NHƯNG KHỐNG BIẾT LÀM PHẦN XUẤT SANG ỄXCEL HAY TXT

(defun C:Q()
(initget 1 "1 2 3")
(Setq kieu (getkword "\nChon : <1>§µo CG <2>§¾p CG <3>Phong ho¸ : "))

(setq OLD_OSMODE (getvar "OSMODE"))
(setvar "OSMODE" 0) ; Tat che do Osnap tu dong

(setq DTich 0.000)

(while (setq P1 (getpoint "\nChon diem trong vung tinh dien tich : "))
(command "Bpoly" P1 "") ; Tao bien tinh S
(command "area" "o" "l") ; Tinh S theo bien da tao
(setq S (getvar "area")) ; Ghi nho gia tri S
(setq DTich (+ DTich S))
)

(setvar "OSMODE" OLD_OSMODE) ; Hoan tra che do Osnap tu dong

(setq P0 (getpoint "\nDiem ghi dien tich : "))

(Cond ((= kieu "1") (setq TXT (strcat "S®µo = " (rtos DTich 2 3) "m2")))
((= kieu "2") (setq TXT (strcat "S®¾p = " (rtos DTich 2 3) "m2")))
((= kieu "3") (setq TXT (strcat "Sph = " (rtos DTich 2 3) "m2")))
)

(setq STYLE_NAME (getvar "TEXTSTYLE"))

(setq STYLE_LIST (tblsearch "STYLE" STYLE_NAME))
(setq TEXT_HEIGHT (cdr (assoc 40 STYLE_LIST)))
(if (= TEXT_HEIGHT 0.0)
(setq H (getreal "\nChieu cao chu : "))
)

(if (/= TEXT_HEIGHT 0.0)
(command "TEXT" P0 0 TXT)
(command "TEXT" P0 H 0 TXT)
)
(prompt "\nProgram complete.")
(princ)
)


(defun C:QQ()
(initget 1 "1 2 3")
(Setq kieu (getkword "\nChon : <1>§µo TC <2>§¾p TC <3>Phong ho¸ : "))

(setq OLD_OSMODE (getvar "OSMODE"))
(setvar "OSMODE" 0) ; Tat che do Osnap tu dong

(setq DTich 0.000)

(while (setq P1 (getpoint "\nChon diem trong vung tinh dien tich : "))
(command "Bpoly" P1 "") ; Tao bien tinh S
(command "area" "o" "l") ; Tinh S theo bien da tao
(setq S (getvar "area")) ; Ghi nho gia tri S
(setq DTich (+ DTich S))
)

(setvar "OSMODE" OLD_OSMODE) ; Hoan tra che do Osnap tu dong

(setq P0 (getpoint "\nDiem ghi dien tich : "))

(Cond ((= kieu "1") (setq TXT (strcat "S®µo = " (rtos DTich 2 3) "m2")))
((= kieu "2") (setq TXT (strcat "S®¾p = " (rtos DTich 2 3) "m2")))
((= kieu "3") (setq TXT (strcat "Sph = " (rtos DTich 2 3) "m2")))
)

(setq STYLE_NAME (getvar "TEXTSTYLE"))

(setq STYLE_LIST (tblsearch "STYLE" STYLE_NAME))
(setq TEXT_HEIGHT (cdr (assoc 40 STYLE_LIST)))
(if (= TEXT_HEIGHT 0.0)
(setq H (getreal "\nChieu cao chu : "))
)

(if (/= TEXT_HEIGHT 0.0)
(command "TEXT" P0 0 TXT)
(command "TEXT" P0 H 0 TXT)
)
(prompt "\nProgram complete.")
(princ)
)
  • 0

#763 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 19 January 2010 - 08:33 PM

Ôi các bác ơi giúp em cái vụ này với chờ mãi chẳng có ai vậy trời

Chào bạn desperado,
Thực ra mình đã đọc yêu cầu của bạn, định trả lời rồi nhưng sợ phạm húy nên lại thôi.
Cái lisp bạn post lên khá là dài và người viết đã bỏ công phu rất nhiều. Trong đoạn lisp này đã có các lệnh để đảm bảo cho bạn không bị mất chế độ truy bắt điểm như các lệnh batsnap, tatsnap, trasnap.
Tuy nhiên có thể do bạn không đọc kỹ nó nên chưa biết cách dùng nó mà thôi.
Còn người viết lisp có thể do họ đã biết có các lệnh này nên trong quá trình viết các lệnh đơn như vẽ mực nước mà bạn đã nêu, họ đặt béng chế độ bắt điểm là none ((command "osnap" "none"), vì vậy khi bạn chạy một mình nó, đương nhiên là mất chế độ bắt điểm.
Nếu bạn muốn chỉ chạy lệnh đơn này mà vẫn giữ nguyên chế độ bắt điểm thì đơn giản là bạn phải thêm vào phía trước dòng code nói trên một đoạn code để lưu chế độ bắt điểm hiện hành của bạn (setq oldos (getvar "osmode")), đồng thời thêm vào cuối lệnh này trước dấu ngoặc kết thúc lệnh một dòng code để khôi phục chế độ bắt điểm (setvar "osmode" oldos).
Với các lệnh khác bạn cũng làm tương tự là mình tin sẽ không bị mất chế độ bắt điểm nữa bạn ạ. Hãy thử xem nhé
Chúc bạn vui và thành công trong cuộc sống.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#764 thanngoctrung

thanngoctrung

    Chưa sử dụng CAD

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

Đã gửi 20 January 2010 - 02:24 PM

Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.

cho minh xin lisp ghi cốt bản vẽ, bằng cách kick điểm.
ví dụ: bản vẽ theo tỉ lệ 1:1.
chọn cốt 0.000(kick diem)
sau đó muốn ghi cot diem nao thi chon diem do
Thanks!
  • 0

#765 Desperado

Desperado

    biết zoom

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

Đã gửi 20 January 2010 - 04:24 PM

Chào bạn desperado,
Thực ra mình đã đọc yêu cầu của bạn, định trả lời rồi nhưng sợ phạm húy nên lại thôi.
Cái lisp bạn post lên khá là dài và người viết đã bỏ công phu rất nhiều. Trong đoạn lisp này đã có các lệnh để đảm bảo cho bạn không bị mất chế độ truy bắt điểm như các lệnh batsnap, tatsnap, trasnap.
Tuy nhiên có thể do bạn không đọc kỹ nó nên chưa biết cách dùng nó mà thôi.
Còn người viết lisp có thể do họ đã biết có các lệnh này nên trong quá trình viết các lệnh đơn như vẽ mực nước mà bạn đã nêu, họ đặt béng chế độ bắt điểm là none ((command "osnap" "none"), vì vậy khi bạn chạy một mình nó, đương nhiên là mất chế độ bắt điểm.
Nếu bạn muốn chỉ chạy lệnh đơn này mà vẫn giữ nguyên chế độ bắt điểm thì đơn giản là bạn phải thêm vào phía trước dòng code nói trên một đoạn code để lưu chế độ bắt điểm hiện hành của bạn (setq oldos (getvar "osmode")), đồng thời thêm vào cuối lệnh này trước dấu ngoặc kết thúc lệnh một dòng code để khôi phục chế độ bắt điểm (setvar "osmode" oldos).
Với các lệnh khác bạn cũng làm tương tự là mình tin sẽ không bị mất chế độ bắt điểm nữa bạn ạ. Hãy thử xem nhé
Chúc bạn vui và thành công trong cuộc sống.

Cảm ơn bạn phamthanhbinh rất nhiều, ý bạn phạm huý là làm sao? Mình là người tổng hợp lại những cái cần dùng lại thành 1 file thôi mà chứ không phải là lấy của 1 người đâu. Mình đã thử nghiệm thành công.
Mình có thể bỏ chế độ này bằng xoá dòng ((command "osnap" "none") này đi có được không , hình như dòng này cần thiết cho lệnh này bạn ạ, mình cũng ko hiểu tại sao khi xoá thì lệnh bị lồi
  • 1

#766 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 20 January 2010 - 09:44 PM

Cảm ơn bạn phamthanhbinh rất nhiều, ý bạn phạm huý là làm sao? Mình là người tổng hợp lại những cái cần dùng lại thành 1 file thôi mà chứ không phải là lấy của 1 người đâu. Mình đã thử nghiệm thành công.
Mình có thể bỏ chế độ này bằng xoá dòng ((command "osnap" "none") này đi có được không , hình như dòng này cần thiết cho lệnh này bạn ạ, mình cũng ko hiểu tại sao khi xoá thì lệnh bị lồi

Hề hề hề,
Mình nói phạm huý ấy là mình sợ nói không trúng ý của người viết lisp, có thể họ có lý do nhất định khi họ viết như vậy.
Còn việc bạn bỏ dòng lệnh (command "osnap" "none" ) đi là không nên đâu vì chế độ osnap (truy bắt điểm) sẽ cho phép bạn click vào 1 điểm gần với điểm cần truy bắt chứ không nhất thiết phải chính xác vào điểm đó. Vì vậy lisp sẽ chạy sai nếu như bạn click chọn điểm ở gần với một điểm nằm trong chế độ truy bắt nghĩa là lisp sẽ lấy kết quả là điểm truy bắt chứ không phải lấy kết quả là chính cái điểm bạn chọn.
Do vậy hầu hết trong các trường hợp sử dụng lisp, mọi người đều cố gắng tắt chế độ truy bắt này để lisp chạy được chính xác với yêu cầu của người dùng.
Rất mừng là bạn đã hiểu được vấn đề và thử nghiệm thành công. Hãy cố gắng dần dần bạn sẽ nắm vững các kiến thức cơ bản về lisp và có thể chủ động được trong công việc của bạn.
Chúc bạn vui.
Hề hề hề.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#767 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 21 January 2010 - 09:29 AM

Bạn xem đoạn lisp sau đây, mình đã bổ sung theo yêu cầu của bạn. Không biết đã đúng chưa, bạn chạy thử nhé.


(defun c:gtb ()
(if (setq ent(entsel "\n Select a Block: ")) ;- Let the user select a block (Chọn block)
(progn
(setq en(car ent)) ;- Get the entity name of the block (lấy tên đối tượng của block)
(setq enlist(entget en)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
(setq blkType(cdr(assoc 0 enlist))) ;- Save the type of entity (lưu lại loại đối tượng)
(if (= blkType "INSERT") ;- If the entity type is an Insert entity
;(nếu loại đối tượng là đối tượng Insert)
(progn
(if(= (cdr(assoc 66 enlist)) 1) ;- See if the attribute flag equals one (if so, attributes follow)
;(Kiểm tra flag thuộc tính )
(progn
(setq en2(entnext en)) ;- Get the next sub-entity (lấy đối tượng phụ tiếp theo)
(setq enlist2(entget en2)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
(setq attvallst (list))
(setq atttaglst (list))
(setq attlst (list))
(while (/= (cdr(assoc 0 enlist2)) "SEQEND") ;- Start the while loop and keep
;- looping until SEQEND is found.
;(Lặp trong khi loại đối tượng không phải SEQEND)
(setq attval (cdr (assoc 1 enlist2))
attvallst (append attvallst (list attval)))
(setq atttag (cdr (assoc 2 enlist2))
atttaglst (append atttaglst (list atttag)))
(setq att (cons atttag attval)
attlst (append attlst (list att)))
(princ "\n ") ;-Print a new line (tạo dòng kết quả mới)
(princ attvallst) ;- Print the attribute value (in ra các gia trị thuộc tính)
(princ "\n")
(princ atttaglst)
(princ "/n")
(princ attlst)
(setq en2(entnext en2)) ;- Get the next sub-entity (lấy đối tượng phụ tiếp theo)
(setq enlist2(entget en2)) ;- Get the DXF group codes (lấy các mã nhóm DXF)
) ; Kết thúc hàm while
) ; Kết thúc hàm thông báo progn lần thứ 3
) ;- Close the if group code 66 = 1 statement (Đóng hàm if kiểm tra mã nhóm 66 )
) ; Kết thúc hàm thông báo progn lần thứ 2
) ;- Close the if block type = "ATTRIB" statement (Đóng hàm if kiểm tra loại đối tượng)
) ; Đóng thông báo progn lần thứ nhất
) ;- Close the if an Entity is selected statement (Đóng hàm if kiểm tra việc chọn đối tượng)
)

Có thể kết quả in ra là thừa so với yêu cầu của bạn, nếu vậy những cái thừa bạn có thể lược bớt nhé. Chỉ cần xóa dòng code (princ "các kết quả thừa đi") bạn ạ
Ví dụ bạn muốn bỏ cái list của các giá trị thuộc tính thì bạn xóa dòng code (princ attvallst).
Trong đoạn lisp trên thực ra bạn có thể đưa các lệnh in kết quả ra sau vòng lặp while vì có thể chả cần in chúng ra giữa chừng khi chưa chạy xong làm chi. Tuy nhiên nếu để như vậy thì khi bạn chạy debug sẽ dễ phát hiện lỗi hơn.
Lisp này là mình mót được của cụ Jeffy Sanders rồi sửa lại tí chút thôi mà.
Chúc bạn vui.

Mình cảm ơn bạn nhiều! Mình biết lisp cũng không qua trường lớp nào cả chỉ bản thân tự học bạn bè, sách vở thôi. Bạn viết như vậy là cẩn thận và dễ hiểu. Minh chạy chương trình là hiểu ý của dòng lệnh. Một lần nữu cảm ơn các bạn !!!
  • 0

#768 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 21 January 2010 - 08:23 PM

Mình cảm ơn bạn nhiều! Mình biết lisp cũng không qua trường lớp nào cả chỉ bản thân tự học bạn bè, sách vở thôi. Bạn viết như vậy là cẩn thận và dễ hiểu. Minh chạy chương trình là hiểu ý của dòng lệnh. Một lần nữu cảm ơn các bạn !!!

Hề hề hề,
Nếu bạn chịu khó xem hết cái topic về autolíp này cũng sẽ vỡ ra được khối thứ đấy bạn ạ. Khi đó chắc bạn sẽ biết tỏng tòng tong rằng mình cũng chỉ là thằng chuyên đi mót mà thôi. Các kiến thức cơ bản về lisp mà mình có được cũng chỉ là bắt đầu từ diễn đàn này, sau đó mày mò tự học và cố gắng tí đỉnh là có thể sử dụng nó phần nào cho công việc của mình. Từ đó có điều kiện để giúp đỡ mọi người mà thôi. Giúp mọi người chính là tự giúp mình nâng cao khả năng của bản thân thôi mà bạn.
Rất mong bạn sẽ sớm trở thành cao thủ về lisp để cùng nhau phát triển bạn nhé.
Hề hề hề....
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#769 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 22 January 2010 - 04:28 PM

Cám ơn bạn Pham Thanh Binh nhé! Mình sẽ cố gắng!
Xin nhờ ban cùng các bạn trên diễn đàn giúp mình một chút về thuật toán:
Mình có một danh sách list dạng: (("a1" "a2" "a3"...) ("b1" "b2" "b3"...) ("c1" "c2" "c3"...)...)
Xin nhờ các bạn chuyển giùm mình sang dạng: ("a1,a2,a3,..." "b1,b2,b3,..." "c1,c2,c3,..."...) để xuất ra file lưu trữ.
Phần xử lý danh sách mình chưa rành lắm. Mong các bạn giúp cho !
  • 0

#770 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 22 January 2010 - 05:08 PM

Cám ơn bạn Pham Thanh Binh nhé! Mình sẽ cố gắng!
Xin nhờ ban cùng các bạn trên diễn đàn giúp mình một chút về thuật toán:
Mình có một danh sách list dạng: (("a1" "a2" "a3"...) ("b1" "b2" "b3"...) ("c1" "c2" "c3"...)...)
Xin nhờ các bạn chuyển giùm mình sang dạng: ("a1,a2,a3,..." "b1,b2,b3,..." "c1,c2,c3,..."...) để xuất ra file lưu trữ.
Phần xử lý danh sách mình chưa rành lắm. Mong các bạn giúp cho !


Bạn thử đoạn code này xem:

(setq lst '(("a1" "a2" "a3") ("b1" "b2" "b3") ("c1" "c2" "c3"))
lst1 '()
)
(foreach e lst
(setq str "")
(foreach s e
(setq str (strcat str "," s))
)
(setq str (vl-string-left-trim "," str)
lst1 (append lst1 (list str))
)
)
lst1

  • 1

#771 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 22 January 2010 - 05:36 PM

Bạn thử đoạn code này xem:


(setq lst '(("a1" "a2" "a3") ("b1" "b2" "b3") ("c1" "c2" "c3"))
lst1 '()
)
(foreach e lst
(setq str "")
(foreach s e
(setq str (strcat str "," s))
)
(setq str (vl-string-left-trim "," str)
lst1 (append lst1 (list str))
)
)
lst1

Cảm ơn bạn NACATA và các bạn. Bạn viết nhanh quá, đoạn mã trên chạy tốt rồi. Chúc bạn cùng các bạn mạnh khỏe, hạnh phúc !
  • 0

#772 duongepu

duongepu

    biết zoom

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

Đã gửi 22 January 2010 - 09:01 PM

Xin chào các pác trong diễn đàn cadviet. Xin chỉnh giúp em bài lisp.

;---Chuong trinh nay dung de ve banh rang---;
;-------------------------;
;-------------------------;
;-------------------------;
(defun dtor (do)
(*(/ pi 180)do))
;-------------------------;
(defun RtoD(doR)
(*(/ 180 pi)doR))

;-------------------------;
(defun cungtrondinh(mot hai)
; -----Ve cung tron SEC-----
; (setq s(getpoint "PdauCungDinhPhai"))(terpri)
; (setq c(getpoint "PTam"))(terpri)
; (setq e(getpoint "PcuoiCungDinhTrai"))(terpri)
(command "arc" mot)
(command "C" tam)
(command hai))
;-------------------------;
(defun cungtronchan()
; -----Ve cung tron SEC-----
(setq s(getpoint "PCuoiCungChanPhai"))(terpri)
; (setq c(getpoint "PTam"))(terpri)
(setq e(getpoint "PcuoiCungChanTrai"))(terpri)
(command "arc" s)
(command "C" tam)
(command e))
;-------------------------;
(defun cungtron_()
; -----Ve cung tron SCA----
;(setq s(getpoint "Diem giao duong than khai voi vong chia"))(terpri)
; (setq c(getpoint "PTam"))(terpri)
; (setq a(getreal "Goc Cung"))(terpri)
(command "arc" s)
(command "C" tam)
(command "A" (- goccungTg)))
;-------------------------;
(setq N(getint "So rang:"))terpri ;So rang
(setq m(getreal "modul:"))terpri
(setq rrr(getint "So doan chia tren chu vi(=:undecided:) ; Ban kinh vong chan
(setq Rcb(* R(cos (dtor 20)))) ; Ban kinh vong co ban
(setq tg(* 1.5708 m)) ; Chieu dai buoc rang (theo cung vong chia)
(setq goccungTg(*(/ pi(* pi R))tg))
(setq goccungTg(rtod goccungTg)) ;Goc cung chua than rang
(terpri)
(setq tam(getpoint "tam:"))
;--------------------------;
(defun vethankhai() ; de chuan bi ve duong than khai
(setq dsdiem nil)
(terpri)


(command "circle" tam rcb)
(setq vt(entlast))
(setq chuvi(* rcb 2 pi))
(setq cungnho(/ chuvi rrr))
(setq gocdo 0)(setq dai cungnho)
(setq goc 0)
(setq i 0)(setq dem 0)
(repeat 36

(setq gocdiem(- (/ pi 2)goc))
(setq diem(polar tam gocdiem rcb ))
; (command "point" diem)
; (command "point" diem(polar diem (+ goc(/ pi 1)) dai) )
(setq diemtk(polar diem (- (/ pi 1)goc) dai))
;------------------------------;
(if (< dem 36)
(progn
(setq kc(distance diemtk tam))
; (princ kc)
(if (<= kc R0)
(if (>= kc Rc)
(setq dsdiem(append dsdiem(list diemtk)))
)
)
)
)

(setq i(+ i (/ 360.0 rrr)))
(setq gocdo i )
(setq goc (dtor gocdo))
(setq dai(+ dai cungnho))
(setq dem(+ dem 1)))
;(command "circle" tam (distance tam(nth 0 dsdiem)))
;(command "circle" tam (distance tam(last dsdiem)))

;------VE Duong THAN KHAI-------;
(setq l(-(length dsdiem)1))
(setq i 0)
(command "Pline" (nth 0 dsdiem))
(repeat l
(setq i(+ i 1))
(command (nth i dsdiem))
)
(command "" )
(setq thankhai(entlast))
(COMMAND "viewres" "" 20000 )
)
;---------------------------------------;
(setvar "osmode" 0)
(vethankhai)
(command "erase" thankhai vt "")
(setq i 1)
(repeat (-(length dsdiem)1)
(if(<(-(distance tam(nth i dsdiem))r)0.01)
(setq giao (nth i dsdiem))
)
(setq i(+ i 1))
)
(setq s giao)
(vethankhai)
(command "zoom" "extents")
(command "erase" vt "")
(command "circle" tam r)
(setq vc(entlast))
(cungtron_)
(setq cung(entlast))
(command "erase" vc "")
(setq tt(entget cung))
(setq g1(assoc 50 tt))
(setq goc1(cdr g1))
(setq g2(assoc 51 tt))
(setq goc2(cdr g2))
(setq goc_(+ goc1(/(- goc2 goc1)2)))

;(command "line" tam(polar tam goc1 r ) "")
;(command "line" tam(polar tam goc2 r) "")
:***Ve duong doi xung qqua cung
(command "line" tam(polar tam goc_ r) "")
(setq duongdx(entlast))
(setq tt(entget duongdx))
(setq d1(cdr(assoc 10 tt)))
(setq d2(cdr(assoc 11 tt)))
(command "mirror" thankhai "" d2 d1 "")
(setq thankhaiP(entlast))
(setq aa(entget thankhaiP))
(setq aaa(reverse aa))
(setq Pmut(cdr(assoc 10 aaa)))
(command "erase" duongdx "")
(command "erase" cung "")
(setvar "osmode" 0)
(setvar "osmode" 1)
(command "zoom" "Extents")
(cungtrondinh Pmut (last dsdiem))
(setq cungdinh(entlast))
(command "zoom" "Extents")
(command "circle" tam Rc)
(setq Vchan(entlasT))
(command "extend" Vchan "" thankhaiP thankhai "")
(command "array" thankhai cungdinh thankhaiP "" "p" tam n "" "")
(command "erase" Vchan "")
(command "zoom" "Extents")
(cungtronchan)
(setq cungchan(entlasT))
(command "array" cungchan "" "p" tam n "" "")
(command "linetype" "set" "center" "")
(command "circle" tam R)
(command "zoom" "all")
(setvar "osmode" 0)
(setvar "ltscale" 25)
(setvar "ltscale" 0.25)
(command "linetype" "set" "continuous" "")
(command "zoom" "Extents")
(command "linetype" "set" "continuous" "")
(prompt "hay chon doi tuong la than rang:")
(COMMAND "pedit" PAUSE "j" "all" "" "")
(setq tl(getstring "co dung 3D ? (Y/n)"))
(if (= tl "Y")
(progn
(terpri)

(setq dt(entsel " chi vao banh rang vua ve"))
(prompt "hay hay chi chieu cao:")
(COMMAND "extrude" dt "" PAUSE "0")
(command "vpoint" "R" 45 45)
))
(princ)







Em muôn sửa lại là :chỉnh sửa phần đường kính trên đỉnh răng với lại chân răng.như hình vẽ cad sau:
banve
mong các bác sửa giúp em với.
Em cảm ơn!
  • 0

#773 Gatesi

Gatesi

    biết vẽ arc

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

Đã gửi 23 January 2010 - 01:40 PM

Em thường làm việc với bản vẽ quy hoạch trong đó có cos nền hiện trạng, việc lọc cos nền này khá khó khăn, e thường phải cho vào Excel rồi dùng bộ lọc Filter, nhưng điều đó chỉ áp dụng đc khi e dùng Nova, bởi vì trong Nova có công cụ xuất text vào và ra bản vẽ, có lisp nào thực hiện điều đó thay Nova ko? đưa text trên bản vẽ ra file TXT với 3 cột ( cột toạ đọ X, cột toạ đọ Y và cột cao độ Z) sau đó dùng lisp xuất ngwợc vào cad sau khi đã xử lí file TXT trên bằng Excel. nhưng khi xuất vào cad thì chỉ là text bình thường theo đúng toạ độ X, Y Z thôi, không cần phải điền ra vị trí, số thứ tự như nova đâu? mong mọi ng giúp đỡ !
  • 0

#774 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 23 January 2010 - 02:07 PM

Em thường làm việc với bản vẽ quy hoạch trong đó có cos nền hiện trạng, việc lọc cos nền này khá khó khăn, e thường phải cho vào Excel rồi dùng bộ lọc Filter, nhưng điều đó chỉ áp dụng đc khi e dùng Nova, bởi vì trong Nova có công cụ xuất text vào và ra bản vẽ, có lisp nào thực hiện điều đó thay Nova ko? đưa text trên bản vẽ ra file TXT với 3 cột ( cột toạ đọ X, cột toạ đọ Y và cột cao độ Z) sau đó dùng lisp xuất ngwợc vào cad sau khi đã xử lí file TXT trên bằng Excel. nhưng khi xuất vào cad thì chỉ là text bình thường theo đúng toạ độ X, Y Z thôi, không cần phải điền ra vị trí, số thứ tự như nova đâu? mong mọi ng giúp đỡ !

Chào Gatesi
Bạn muốn lọc như thế nào? Xuất như thế nào? thì Tue_NV chưa được hiểu?
Có lẽ bạn nên upload file Excel và file .dwg và nói rõ ràng hơn điều bạn muốn nói.
Nói càng rõ ràng, càng minh hoạ, càng chi tiết thì càng tốt bạn ạ.

Chúc vui vẻ
  • 0

#775 Gatesi

Gatesi

    biết vẽ arc

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

Đã gửi 23 January 2010 - 09:28 PM

Chào Gatesi
Bạn muốn lọc như thế nào? Xuất như thế nào? thì Tue_NV chưa được hiểu?
Có lẽ bạn nên upload file Excel và file .dwg và nói rõ ràng hơn điều bạn muốn nói.
Nói càng rõ ràng, càng minh hoạ, càng chi tiết thì càng tốt bạn ạ.

Chúc vui vẻ

http://www.mediafire.com/?memevwlj33z
đây là file của e, trong đó nói rõ yêu càu, mong a giúp cho, thông cảm vì lúc e post bài chức năng upload của diễn đàn bị lỗi,
Chúc cả nha cuối tuần vui vẻ
  • 0

#776 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 24 January 2010 - 08:36 AM

http://www.mediafire.com/?memevwlj33z
đây là file của e, trong đó nói rõ yêu càu, mong a giúp cho, thông cảm vì lúc e post bài chức năng upload của diễn đàn bị lỗi,
Chúc cả nha cuối tuần vui vẻ

bạn chạy thử code này nhé: (defun c:txt( / text_loc fn sset f i txt p x y z)
(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p loc)
)
)
(setq ketqua p)
)
;end sub text_loc
(if (not path) (setq path "d:\\"))
(setq fn(getfiled "Ghi vao file toa do xyz" path "xyz" 1))
(if fn(progn
(setq path (vl-filename-directory fn))
(setq sset(ssget '((0 . "TEXT"))))
(if sset
(progn
(setq f(open fn "w"))
(setq i 0 n (sslength sset))
(repeat n
(setq entn(ssname sset i)
entg(entget entn)
txt (cdr (assoc 1 entg))
p(text_loc entn)
x (rtos (car p) 2 3)
y (rtos (cadr p) 2 3)
z (rtos (caddr p) 2 3)
txt (strcat txt "\t" y "\t" x "\t" z)
i(+ i 1)
)
(write-line txt f)
)
(close f)
(alert "chuong trinh da chay xong")
)
(alert "khong thuc hien duoc")
)
)
)
)
(defun c:xyz( / fn f )
(if (not path) (setq path "d:\\"))
(setq fn(getfiled "Chon vao file xyz" path "xyz" 2))
(if fn
(progn
(setq f(open fn "r")
mb '())
(while (setq dat(read-line f))
(setq dat(vl-string->list dat)
line ""
ma '())
(foreach pp dat
(if (and (/= pp 9) (/= pp 32))
(setq line (strcat line (vl-list->string (list pp))))
(setq ma(append ma (list line)) line "")
)
)
(setq ma(append ma(list line)))
(setq mb(append mb(list ma)))
)
(close f)
(if mb
(foreach pp mb
(setq txt (nth 0 pp)
p(list(atof(nth 2 pp)) (atof(nth 1 pp)) (atof (nth 3 pp))))
(command "text" p 1.5 0 txt)
)
)
)
)
)
  • 1

#777 eike2000

eike2000

    biết pan

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

Đã gửi 25 January 2010 - 09:20 AM

Mình muốn xin 1 số lisp như sau :
1. vẽ hình chữ nhật bằng 3 điểm hoặc 2 đường thằng.Trong SpeedCAD có lisp này.
2. vẽ 1 hcn, xoá tất cả các đối tượng trong hình chũ nhật đó ( kết hợp giửa extrim và del ). Nếu trim text, block càng tốt
3. strect hatch mà nó ban đầu là pickpoint và không có chọn asscessories
trong 1 số trườngh hợp có ai biết cách đổi lệnh trong speecad không?

cái này ngoài lề. Có ai có tài liệu "hướng dẩn phát triển autolisp cho người ngu" không? tên tiếng anh của nó là : "develop knowledge autolisp fo foolish"
những tài liệu việt nam, người soạn giỏi quá nên cũng tưởng ai cũng giỏi bằng mình, viết cho tự mình hiểu rồi tự mình sướng hết rồi.
  • 0

#778 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 25 January 2010 - 10:08 AM

cái này ngoài lề. Có ai có tài liệu "hướng dẩn phát triển autolisp cho người ngu" không? tên tiếng anh của nó là : "develop knowledge autolisp fo foolish"
những tài liệu việt nam, người soạn giỏi quá nên cũng tưởng ai cũng giỏi bằng mình, viết cho tự mình hiểu rồi tự mình sướng hết rồi.

Bạn viết như vậy mà bác Nguyễn Hoành và các bác trên diễn đàn nghe được chắc buồn lắm. Cất công viết những đoạn Code thật đơn giản cho những người bắt đầu học cho dễ hiểu nhất. Cuối cùng, bạn lại phát ra những lời như vậy, thật là buồn quá.
Hoc AutoLisp - Danh cho nguoi bat dau

Không biết bạn đã nghe câu này chưa : "Dốt đến đâu học lâu cũng biết".
Mình từ khi tham gia diễn đàn, có thể nói là người dốt, vì mình chưa biết gì cả. Nhưng mình luôn tâm niệm là "Dốt đến đâu học lâu cũng biết" cho nên phải học thôi, chẳng còn cách nào cả.
Vì "Có học mới hay, có cày mới biết. Không học, không chịu cày thì.... dốt vẫn hoàn dốt, ngu vẫn là ngu.

Vì đây là topic này là Viết Lisp theo yêu cầu nên mình không muốn thảo luận vấn đề này của bạn ở đây. Nếu bạn muốn thảo luận thì xin mời bạn đến quán Thảo luận vỉa hè.

Chúc bạn thành công.
  • 0

#779 Gatesi

Gatesi

    biết vẽ arc

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

Đã gửi 25 January 2010 - 10:17 AM

bạn chạy thử code này nhé: (defun c:txt( / text_loc fn sset f i txt p x y z)
(defun text_loc (entn / p entg text jum72 jum73 i loc ketqua)
(setq p '())
(setq entg (entget entn))
(setq text (cdr (assoc 0 entg)))
(if (= text "TEXT")
(progn
(setq jum72 (cdr (assoc 72 entg)))
(setq jum73 (cdr (assoc 73 entg)))
(cond
((= jum72 1) (setq i 11))
((= jum72 2) (setq i 11))
((= jum72 4) (setq i 11))
((= jum72 3) (setq i 10))
((= jum72 5) (setq i 10))
((= jum72 0)
(progn
(if (= jum73 0)
(setq i 10)
(setq i 11)
)
)
)
)
(setq loc (cdr (assoc i entg)))
(setq p loc)
)
)
(setq ketqua p)
)
;end sub text_loc
(if (not path) (setq path "d:\\"))
(setq fn(getfiled "Ghi vao file toa do xyz" path "xyz" 1))
(if fn(progn
(setq path (vl-filename-directory fn))
(setq sset(ssget '((0 . "TEXT"))))
(if sset
(progn
(setq f(open fn "w"))
(setq i 0 n (sslength sset))
(repeat n
(setq entn(ssname sset i)
entg(entget entn)
txt (cdr (assoc 1 entg))
p(text_loc entn)
x (rtos (car p) 2 3)
y (rtos (cadr p) 2 3)
z (rtos (caddr p) 2 3)
txt (strcat txt "\t" y "\t" x "\t" z)
i(+ i 1)
)
(write-line txt f)
)
(close f)
(alert "chuong trinh da chay xong")
)
(alert "khong thuc hien duoc")
)
)
)
)
(defun c:xyz( / fn f )
(if (not path) (setq path "d:\\"))
(setq fn(getfiled "Chon vao file xyz" path "xyz" 2))
(if fn
(progn
(setq f(open fn "r")
mb '())
(while (setq dat(read-line f))
(setq dat(vl-string->list dat)
line ""
ma '())
(foreach pp dat
(if (and (/= pp 9) (/= pp 32))
(setq line (strcat line (vl-list->string (list pp))))
(setq ma(append ma (list line)) line "")
)
)
(setq ma(append ma(list line)))
(setq mb(append mb(list ma)))
)
(close f)
(if mb
(foreach pp mb
(setq txt (nth 0 pp)
p(list(atof(nth 2 pp)) (atof(nth 1 pp)) (atof (nth 3 pp))))
(command "text" p 1.5 0 txt)
)
)
)
)
)

Rất đúng ý của em, cám ơn bác ! :undecided:
Nhưng e mún hỏi 1 tý, sao không save file duôi txt mà lại save đuôi xyz, save đuôi txt dùng excel chỉnh sửa có phải dơn giản hơn ko?
  • 0

#780 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 25 January 2010 - 03:13 PM

Rất đúng ý của em, cám ơn bác ! :undecided:
Nhưng e mún hỏi 1 tý, sao không save file duôi txt mà lại save đuôi xyz, save đuôi txt dùng excel chỉnh sửa có phải dơn giản hơn ko?

bạn thay code (setq fn(getfiled "Ghi vao file toa do xyz" path "xyz" 1))
bằng code này nhé (setq fn(getfiled "Ghi vao file toa do xyz" path "txt,xyz" 1))
và dòng này nữa nhé: (setq fn(getfiled "Chon vao file xyz" path "xyz" 2))
bằng dòng này: (setq fn(getfiled "Chon vao file xyz" path "txt,xyz" 2))
  • 1