Đế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

#2021 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 September 2010 - 07:03 AM

á á..Em mạn phép test code thì được kết quả như sau :
Đường màu đỏ là 0A,0B của e.2 đường màu xanh là kết quả sau ki chạy lsp.Còn đường màu xanh dương đứt đứt là e vẽ vào để thấy rõ 0A=0B,và 2 cung tròn kia cũng ằm gọn lỏn trong ấy luôn.Không biết thao tác của e có gì sai không nữa :|
Hình đã gửi

Bạn thao tác không sai. Chẳng qua là Code của bạn Tú không lường hết các tình huống xảy ra được
Bạn kéo dài đoạn OB sẽ thấy nó là đường tiếp tuyến của cung trên
Bạn kéo dài đoạn OA sẽ thấy nó là đường tiếp tuyến của cung dưới
Bạn thử với Lisp của Tue_NV đã post ở bài viết trên thử nhé
  • 0

#2022 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 08:00 AM

Là code vatt.vlx bác ạ :(
Thêm 1 điểm nữa là osmode bị tắt quá sớm,trước cả khi cho phép người dùng kick vào tiếp điểm A hoặc B bác ạ :
  • 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


#2023 hoan2182

hoan2182

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2646 Bài viết
Điểm đánh giá: 832 (rất tốt)

Đã gửi 29 September 2010 - 08:11 AM

Hề hề hề, sai tóe loe là sao?
Có góc giao giữa hai đường thẳng rồi, có chiều dài tiếp tuyến rồi, chỉ đi tìm R thôi mà.
Công thức tính R đây luôn:
R=T/(tan(pi-a/2))
T: chiều dài đường tang (chiều dài tiếp tuyến) - chính là khoảng cách OA, OB
a: góc hợp giữa OA và OB (tính bằng rad)

Phần còn lại là của các bác.
Hề hề hề

Có hai đường thẳng rồi,
Không cần biết góc độ của nó là bao nhiêu
không cần xác định bán kính R
vẫn dựng được ngon lành và nhanh gọn!
Anh vào mục đố vui suy nghĩ thêm và suy ngẫm những luôn cả lời nói của bác Bình:"Chỉ mong bạn hãy suy ngẫm cho kỹ những gì mình nói để may ra có thể có ích cho chính bạn".
http://www.cadviet.c...mp;#entry110048
  • 0

Gió đưa cây cải về trời

Rau răm ở lại chịu lời đắng cay...


#2024 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 September 2010 - 08:26 AM

Là code vatt.vlx bác ạ :(
Thêm 1 điểm nữa là osmode bị tắt quá sớm,trước cả khi cho phép người dùng kick vào tiếp điểm A hoặc B bác ạ :

Quên mất, không mang theo file lên công ty rồi nên chưa sửa được. Bạn chịu khó bật osnap lên (trong lúc chạy Lisp) và chọn điểm vậy
Cái này là Tue_NV cố ý gửi file Lisp mã hoá lên để bạn Tu có thể giải ra câu đố và tự tìm lấy đáp án cho mình. Trường hợp mà bạn ấy chưa tìm ra lời giải thì mình sẽ post code lên để giúp cho bạn ấy nhưng Tue_NV nghĩ là không cần vì bạn Tú có thể giải đuợc bài toán này 1 cách thuyết phục bằng AutoLisp. Lẽ đương nhiên, vẽ bằng CAD cũng không chậm hơn là mấy :(
  • 0

#2025 manhdlk

manhdlk

    biết pan

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

Đã gửi 29 September 2010 - 09:03 AM

Chào các bác.
Em xin cảm ơn tất cả các bác vì đã góp ý và giúp đỡ em.
Trở lại bài toán dễ mà khó, khó mà dễ của em.
@ phamngoctukts: cái lisp sau cùng bác fix cho em khá ổn, nhưng còn tồn tại trường hợp như bác Tue_NV thông báo, và quan trọng là góc hợp giữa 2 đường =>90 thì ... bó tay
@ Tue_NV: bác xem lại trường hợp góc vuông ạ.

Theo thiển ý của em thì em giải quyết nó như thế này ạ (đối với trường hợp làm thủ công):
1. Chọn đường thứ nhất
2. Chọn đường thứ hai
----> tìm ra góc hợp a giữa hai đường (sẽ lấy góc <180 độ).
3. Chọn điểm tiếp xúc (chọn 1 trong hai điểm trên hai đường)
----> Tính ra được T là khoảng cách từ điểm giao giữa hai đường thẳng đến điểm tiếp xúc
4. Tính R theo công thức R=T/tang((pi-a)/2)
5. Vẽ đường tròn tiếp xúc với hai đường thẳng trên với bán kính R (tan - tan- radius)
6. Trim đoạn cung tròn phía ngoài (đoạn dài)

OK

Em lập luận là như vậy đối với trường hợp làm thủ công, còn với ngôn ngữ lisp thì em đang mày mò. Có gì chưa ổn mong các bác bớt chút thời gian đóng góp ý kiến cho anh em ngày càng tiến bộ.
Mong diễn đàn ngày càng lớn mạnh.
  • 0

#2026 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 09:14 AM

Quên mất, không mang theo file lên công ty rồi nên chưa sửa được. Bạn chịu khó bật osnap lên (trong lúc chạy Lisp) và chọn điểm vậy
Cái này là Tue_NV cố ý gửi file Lisp mã hoá lên để bạn Tu có thể giải ra câu đố và tự tìm lấy đáp án cho mình. Trường hợp mà bạn ấy chưa tìm ra lời giải thì mình sẽ post code lên để giúp cho bạn ấy nhưng Tue_NV nghĩ là không cần vì bạn Tú có thể giải đuợc bài toán này 1 cách thuyết phục bằng AutoLisp. Lẽ đương nhiên, vẽ bằng CAD cũng không chậm hơn là mấy :(

Híc,e định mò mẫm tìm ý đồ trong code của bác nhưng gặp hàm lấy giao của express,rồi lại gặp mấy dòng (setq ... Then or Else) là e chịu luôn.Vì e chưa biết nó có nghĩa là gì :(.
  • 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


#2027 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 29 September 2010 - 09:18 AM

@truongthanh : đã fix lỗi thứ tự đường kính theo quy luật cho bạn ở bài viết 2018

@Anh TUE và anh BÌNH cho em hỏi với, sao cùng 1 file cad mà 2 lisp của 2 anh cho ra 2 bảng thống kê khác nhau và khác cả bảng thống kê em làm bằng excel luôn, em gửi file CAD đính kèm nhờ các anh kiểm tra lại giúp em với nhen! (Em ko có ý so sánh 2 lisp của 2 anh viết, vì cùng 1 nội dung mà được 2 cao thủ như 2 anh giúp là niềm vinh hạnh của em)
Cảm ơn 2 anh nhiều!
http://www.cadviet.c...s/3/testnew.dwg
@Anh BÌNH: Sao cái bảng kẻ khung của anh lúc vẽ ra cái khung nó ko hoàn chỉnh vậy anh?(Thiếu mấy cái pline của khung) :(
P/S: Cho phép em gọi 2 anh bằng anh vì em nhỏ tuổi hơn 2 anh nhiều, trước đây em cứ xưng tên em thấy kỳ quá!
  • 0

#2028 manhdlk

manhdlk

    biết pan

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

Đã gửi 29 September 2010 - 10:19 AM

Có hai đường thẳng rồi,
Không cần biết góc độ của nó là bao nhiêu
không cần xác định bán kính R
vẫn dựng được ngon lành và nhanh gọn!
Anh vào mục đố vui suy nghĩ thêm và suy ngẫm những luôn cả lời nói của bác Bình:"Chỉ mong bạn hãy suy ngẫm cho kỹ những gì mình nói để may ra có thể có ích cho chính bạn".
http://www.cadviet.c...mp;#entry110048


Đá xoáy thế bác? Hề hề hề... Câu hỏi trong mục đố vui của bác Tuệ là bài toán hình học lớp 8 của em chứ đâu, hí hí...
  • 0

#2029 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 10:49 AM

Hì hì đơn giản lắm lắm. Đây là cách dựng cung Arc tiếp xúc với 2 đường thẳng d1 d2 cắt nhau. Hổng cần đến Lisp vẫn cứ dựng cung arc 1 cách nhanh nhất.
Bạn suy nghĩ phức tạp quá thành ra code của bạn cũng phức tạp theo. Bạn nói "thử bắt tay vào xem" thì xin thưa với bạn là Tue_NV đã bắt tay vào rồi. XOng hồi tối hôm qua cơ, sáng sơm này chờ bạn post lên mới có hồi âm
Nó đây : Lisp ve cung VATT
Bạn Tu va manhdlk thử xem

Bạn Tú thử câu hỏi này xem. Và trả lời xong câu hỏi này thì Tue_NV tin rằng bạn Tú sẽ tự mình xây dựng được code trên theo 1 cách ngắn gọn nhất
Câu hỏi đó nằm ở đây : Để topic này không rơi vào quên lãng
Code quá phức tạp. Đau đầu 1 chút thì đâu có sao nếu như biết thêm 1 cái mới. Giải được câu đố trên sẽ hết đau liền. Đây là kiến thức về cách vẽ cung được học hồi vẽ các lênh CAD cơ bản

@truongthanh : đã fix lỗi thứ tự đường kính theo quy luật cho bạn ở bài viết 2018

Bác tue_TN ác quá thế mà không nói sớm để đàn em đau đầu. Bác nói xong em mới nghiên cứu lại cách vẽ arc thì ra nó có rất nhiều lựa chọn mà mình không biết. Em vẫn chưa trả lời đuọc câu hỏi của bác nhưng Bác đã giúp em viết code ngắn lại rất nhiều và không bị sai nưa. Thank. Thì ra còn rất nhiều thứ tưởng đơn giản mà mình lại không biết. hề hề

;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4)
)
(if (equal giao pg1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1))
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(command "arc" p1 "e" p2 "d" giao)
)

BS: hề hề em test code của bác tìm ra lỗi này
Hình đã gửi
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2030 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 11:20 AM

Em không hiểu sao chay code của em trước thì ok. Em load thêm code của bác vào ròi thì chay code của em sai toé loe. Test thử thì thấy cái đoạn (equal giao pg1) bao giờ cũng báo nil. Có lẽ code của bác tác động vào biến hệ thống nào đó làm nó không còn đúng nữa.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2031 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 29 September 2010 - 12:57 PM

@Anh TUE và anh BÌNH cho em hỏi với, sao cùng 1 file cad mà 2 lisp của 2 anh cho ra 2 bảng thống kê khác nhau và khác cả bảng thống kê em làm bằng excel luôn, em gửi file CAD đính kèm nhờ các anh kiểm tra lại giúp em với nhen! (Em ko có ý so sánh 2 lisp của 2 anh viết, vì cùng 1 nội dung mà được 2 cao thủ như 2 anh giúp là niềm vinh hạnh của em)
Cảm ơn 2 anh nhiều!
http://www.cadviet.c...s/3/testnew.dwg
@Anh BÌNH: Sao cái bảng kẻ khung của anh lúc vẽ ra cái khung nó ko hoàn chỉnh vậy anh?(Thiếu mấy cái pline của khung) :(
P/S: Cho phép em gọi 2 anh bằng anh vì em nhỏ tuổi hơn 2 anh nhiều, trước đây em cứ xưng tên em thấy kỳ quá!

Chào bạn Truongthanh,
Sở dĩ cái kết quả cửa lisp do mình viết khác với cái kết quả mà bạn làm bằng Excel là do thằng cu này đây:
"Ø800 - L120- i1.25"
Do cấu trúc text của bạn bị sai (thiếu một khoảng trắng giữa các ký tự chỉ chiều dài và dấu gạch ngang) nên lisp nó đọc kết quả bị sai. Thay vì phải là 120 thì nó chỉ đọc được là 12.
Vì thế nên hai kết quả chênh lệch nhau đúng 108 đơn vị bạn ạ.
Còn cái vụ tại sao bạn chạy lisp thì nó lại vẽ thiếu đường line thì mình đoán là do các biến hễ thống của bạn mà thôi. Bởi vì mình chạy thì nó vẫn ra kết quả ngon lành. Bạn xem đây, không phải chỉ một lần chạy mà chạy rất nhiều lần . Có khác chăng chỉ là cái text nó không ra tiếng Việt là do nó sử dụng style khác mà thôi.
http://www.cadviet.c...truongthanh.jpg

Mình sẽ kiểm tra lại cái style này để cho nó hiển thị đúng.

Và đây là cái kết quả chạy ra sau khi mình đã sửa cái text sai của bạn cho đúng cấu trúc như mình đã mô tả ở bài trước.

Trang upload của diễn đàn trục trặc nên mình không upload ảnh cho bạn thấy được. Mình sẽ upload sau vậy. Bạn cứ thử sửa lại cái text đó và chạy lại xem nhé.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2032 hoan2182

hoan2182

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2646 Bài viết
Điểm đánh giá: 832 (rất tốt)

Đã gửi 29 September 2010 - 01:20 PM

Đá xoáy thế bác? Hề hề hề... Câu hỏi trong mục đố vui của bác Tuệ là bài toán hình học lớp 8 của em chứ đâu, hí hí...

:( :D :( :)
Em vào diễn đàn học là chính và thư giãn mua vui ko mất tiền cũng là chính luôn. Đá xoáy là gì em ko biết, em nghĩ sao viết vậy và sống vô tư lúc nào cũng mỉm cười trước thời đại. Chắc là anh giỏi môn đá xoáy nên nghĩ người khác cũng đá xoáy giống mình. Mỗi người có một cách sống riêng không ai giống ai. Anh đừng nghĩ là bụng trâu cũng như bụng bò anh ạ!
  • 0

Gió đưa cây cải về trời

Rau răm ở lại chịu lời đắng cay...


#2033 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 01:32 PM

Em không hiểu sao chay code của em trước thì ok. Em load thêm code của bác vào ròi thì chay code của em sai toé loe. Test thử thì thấy cái đoạn (equal giao pg1) bao giờ cũng báo nil. Có lẽ code của bác tác động vào biến hệ thống nào đó làm nó không còn đúng nữa.

Code của bác Tue dùng các hàm Inters,(acet-geom-intersestwith en1 en2 flag),entmake,entdel...k iết có ảnh hởng j k.E không thấy có gì bất thường về biến hệ thống bác ạ.Nhưng hiện code chạy vẫn chưa chuẩn nên chưa thể bình luận gì thêm ^^
  • 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


#2034 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 01:43 PM

Code của bác Tue dùng các hàm Inters,(acet-geom-intersestwith en1 en2 flag),entmake,entdel...k iết có ảnh hởng j k.E không thấy có gì bất thường về biến hệ thống bác ạ.Nhưng hiện code chạy vẫn chưa chuẩn nên chưa thể bình luận gì thêm ^^

Bạn load code đã sửa của mình test thừ chưa. Mình test thấy mọi trường hợp đều ok.
đâu là đoạn code trong file vatt.vlx của bác Tue_VN
(defun main
FasStringtables 0
FasStringtables 1
(defun main
nil
(alert "copyright by Tue_NV. Go VATT de bat dau")
(setq C:VATT C:VATT)
(vl-ACAD-defun C:VATT)
(defun C:VATT
(_al-bind-alist '(OLDOS SS D1 D2 D3 D4 P1 G))
(SETVAR "cmdecho" 0)
(setq OLDOS (GETVAR "osmode"))
(SETVAR "osmode" 0)
(setq SS (SSGET '((cons 0 "line"))))
(setq E1 (SSNAME SS 0))
(setq D1 (CDR (ASSOC 10 (ENTGET (setq E1 (SSNAME SS 0))))))
(setq D2 (CDR (ASSOC 11 (ENTGET E1))))
(setq E2 (SSNAME SS 1))
(setq D3 (CDR (ASSOC 10 (ENTGET (setq E2 (SSNAME SS 1))))))
(setq D4 (CDR (ASSOC 11 (ENTGET E2))))
(setq P1 (GETPOINT "\nchon diem tiep xuc :"))
(setq G (INTERS D1 D2 D3 D4 T))
(setq E (ENTMAKEX (LIST (CONS 0 "CIRCLE") (CONS 10 G) (CONS 40 (DISTANCE P1 G)))))
(setq G1 (ACET-GEOM-INTERSECTWITH Then OR Else E1 3))
(setq G2 (ACET-GEOM-INTERSECTWITH E E2 3))
(setq D1 (CAR G1))
(setq D1 Then OR Else)
(setq D2 (CAR G2))
(setq D2 Then OR Else)
(VL-CMDF "arc" D1 "e" D2 "D" G)
(ENTDEL E)
(SETVAR "osmode" OLDOS)
nghe cũng dài ra phết. Bác dùng nhiều code ActivezX quá trả hiểu gì cả. Bác giải thích một chút cho anh em mót. Và cũng không hiểu bác tạo ra Circle trước để làm gì.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2035 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 02:23 PM

Thì e hỏi ngay bác Tue mấy dòng Then Or Else,acet lấy giao lấy giếc ... :(
E rất tiếc thông báo với bác là e vừa test code xong,vẫn chưua chuân~ bác ạ :|
  • 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


#2036 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 September 2010 - 02:39 PM

Thì e hỏi ngay bác Tue mấy dòng Then Or Else,acet lấy giao lấy giếc ... :(
E rất tiếc thông báo với bác là e vừa test code xong,vẫn chưua chuân~ bác ạ :|

Code của Tue_NV chỉ áp dụng khi góc hợp bởi 2 tiếp tuyến là góc nhọn thôi. Còn góc vuông và góc tù thì chưa đúng.
Lisp của bạn Tú còn 1 điểm chưa đúng. Hiện giờ công việc của mình khá bận. Hẹn tối nay, mình sẽ viết bài rồi post tiếp
  • 0

#2037 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 03:46 PM

Thì e hỏi ngay bác Tue mấy dòng Then Or Else,acet lấy giao lấy giếc ... :(
E rất tiếc thông báo với bác là e vừa test code xong,vẫn chưua chuân~ bác ạ :|

Chưa chuẩn chỗ nào vậy bạn. Lại mập mờ rồi hê hê. port lên đi để mình còn fix
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2038 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 29 September 2010 - 04:10 PM

Nhờ bác Tue_NV bổ sung thêm đoạn code dưới đây chính do bác viết để có thể lấy thêm code màu của các layers luôn.
Cám ơn Bác nhiều.
(defun c:L2F (/ fname tbl_lst); Layer and Status to File
;; By : Tue_NV, tue_nvcc@yahoo.com
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
La (vla-get-layers doc) i -1 tbl_lst '())
(vlax-for ob La
(setq tbl_lst (append tbl_lst (list
(list (vla-get-name ob)
(status(vla-get-layeron ob))
(status(vla-get-freeze ob))
(status(vla-get-lock ob)) )) ))
)
(if (setq fName (getfiled "Ten file xuat Layer" (getvar "dwgprefix") "xls" 1))
(progn
(setq fName (open fName "a"))
;(write-line (strcat "Danh sach Layer trong file : " (getvar"dwgname"))fName)
;(write-line "Name\tLAYON\tFreeze\tLOCK" fname)
(foreach pt (vl-sort tbl_lst '(lambda (x y) (< (car x) (car y))))
(write-line (strcat (nth 0 pt) "\t" (nth 1 pt) "\t"
(nth 2 pt) "\t" (nth 3 pt)) fName)
)
(close fName)))

(princ)
)
(defun status(a)
(if (= a :vlax-true)
(setq a "ON")
(setq a "OFF")
)
)

  • 0

#2039 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 04:13 PM

Có phải code ở bài 2059 không ạ ?? E test ...chưa được phát nào.Tình trạng lúc nào cũng như thế này ạ :
Màu xanh là 2 đường có sẵn.Màu vàng là đường tròn e vẽ để lấy OA,OB..Còn màu đỏ là ết quả att chạy sau khi e chọn điểm tiếp xúc là A..Mà e cũng thấy lạ cơ.Code của bác,của bác Tue...e thử đều bị lỗi,chưa được cái nào ý.Hay cad e có vấn đề ??
Hình đã gử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


#2040 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 September 2010 - 04:26 PM

Nhờ bác Tue_NV bổ sung thêm đoạn code dưới đây chính do bác viết để có thể lấy thêm code màu của các layers luôn.
Cám ơn Bác nhiều.
............

Code bổ sung thêm cho Phi phi đây :

(defun c:L2F (/ fname); Layer and Status to File
;; By : Tue_NV, tue_nvcc@yahoo.com
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
La (vla-get-layers doc) i -1 tbl_lst '())
(vlax-for ob La
(setq tbl_lst (append tbl_lst (list
(list (vla-get-name ob)
(status(vla-get-layeron ob))
(status(vla-get-freeze ob))
(status(vla-get-lock ob))
(vla-get-color ob) )) ))
)
(if (setq fName (getfiled "Ten file xuat Layer" (getvar "dwgprefix") "xls" 1))
(progn
(setq fName (open fName "a"))
;(write-line (strcat "Danh sach Layer trong file : " (getvar"dwgname"))fName)
;(write-line "Name\tLAYON\tFreeze\tLOCK" fname)
(foreach pt (vl-sort tbl_lst '(lambda (x y) (< (car x) (car y))))
(write-line (strcat (nth 0 pt) "\t" (nth 1 pt) "\t"
(nth 2 pt) "\t" (nth 3 pt) "\t" (itoa (nth 4 pt)) ) fName)
)
(close fName)))

(princ)
)
(defun status(a)
(if (= a :vlax-true)
(setq a "ON")
(setq a "OFF")
)
)

:(
  • 1