Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

Các bài được khuyến nghị

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ì :(.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
@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.com/upfiles/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á!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.com/forum/index.php?sho...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í...

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

vatt.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
@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.com/upfiles/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.com/upfiles/3/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é.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Đá 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 ạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 ^^

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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ì.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 ạ :|

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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")
)
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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 đề ??

capturesgu.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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) ((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")
)
)

:(

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 đề ??

capturesgu.jpg

Lúc viết xong chạy ngon lành mà sao giờ test lại sai toé loe thế này hả trời. Híc híc

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Đúng là cái này dùng thủ công còn nhanh hơn dùng lisp.

Nó phân ra quá nhiều trường hợp. Trong hàm đặt quá nhiều điều kiện. Mình đã đặt thế này rồi mà vẫn thiếu lúc thì đúng lúc thì sai. Thật đau cái đầu.

Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là

mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.

Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:

- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)

- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.

- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.

Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn

(defun c:ptt ( / ss pg1 pg2 pg3 pg4 p1 p2 giao d om)

(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 nil)
			d (distance giao p1)
			om (getvar "osmode")
			)
(setvar "osmode" 0)

;;;	(if (equal giao pg1 1.e-8)
;;;		(setq ang1 (angle giao pg2))
;;;		(setq ang1 (angle giao pg1))
;;;		)
;;;	(setq p1 (polar giao ang1 d))
;;;	
;;;	(if (equal giao pg3 1.e-8)
;;;		(setq ang2 (angle giao pg4))
;;;		(setq ang2 (angle giao pg3))
;;;		)
;;;	(setq p2 (polar giao ang2 d))

(setq p1 (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d))
(setq p2 (polar giao (angle giao (if (equal giao pg3 1.e-8)pg4 pg3)) d))

(command "arc" p1 "e" p2 "d" giao)
(setvar "osmode" om)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là

mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.

Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:

- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)

- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.

- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.

Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn

;; 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 1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3 1)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1) 1)
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(command "arc" p1 "e" p2 "d" giao)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Đúng là mình tìm ra lỗi rồi với hàm equal thì phải cho tham số chính xác nếu không có thì nhiều trường hợp sẽ báo nil

code này đã sửa rồi và test thấy đúng không biết chạy trên máy kác thì thế nào. Cám ơn bạn đã giúp mình nhưng nhờ gợi ý của bác Tue_VN mà mình đã tìm ra rôi. Vì mình không được học cad từ cơ bản nên mới thế này đây

;; 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 1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3 1)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1) 1)
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(command "arc" p1 "e" p2 "d" giao)
)

Chúc mừng bạn PhamngocTukts hết bị đau đầu :( Bạn đã giải ra câu đố của Tue_NV rồi đấy

..............

@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.com/upfiles/3/testnew.dwg

Chào truongthanh

Sorry em, anh đã fix lỗi ở Bài viết số 2018. Em chạy thử nhá

Chúc mọi người vui vẻ

Thân ái

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.com/upfiles/3/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é.

 

Do không biết cái style bạn thường dùng cho các bản vẽ này nên mình không bổ sung phần tạo style cho text nữa. Tỷ như trong bản vẽ testnew.dwg mà bạn gửi sau cùng thì nếu bạn bổ sung thêm (cons 7 "1") vào các dòng code (enmake (list (cons 0 "TEXT") ....... ) ) để thành (enmake (list (cons 0 "TEXT") ....... (cons 7 "1") ) ) Thì nó sẽ hiển thị đúng tiếng Việt vì trong bản vẽ này bạn sử dụng style có tên là "1" cho các text tiếng Việt bạn ạ.

Còn trong bản vẽ Bang_thong_ke.dwg bạn gửi lần trứơc thì bạn lại dùng style có tên là "ahs-Arial". Khi đó bạn phải thay (cons 7 "1" ) bằng (cons 7 "ahs-Arial") hoặc bạn phải bổ sung cái Style "1" này vào bản vẽ của bạn bạn nhé.

 

Chúc bạn vui.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Do không biết cái style bạn thường dùng cho các bản vẽ này nên mình không bổ sung phần tạo style cho text nữa. Tỷ như trong bản vẽ testnew.dwg mà bạn gửi sau cùng thì nếu bạn bổ sung thêm (cons 7 "1") vào các dòng code (enmake (list (cons 0 "TEXT") ....... ) ) để thành (enmake (list (cons 0 "TEXT") ....... (cons 7 "1") ) ) Thì nó sẽ hiển thị đúng tiếng Việt vì trong bản vẽ này bạn sử dụng style có tên là "1" cho các text tiếng Việt bạn ạ.

Còn trong bản vẽ Bang_thong_ke.dwg bạn gửi lần trứơc thì bạn lại dùng style có tên là "ahs-Arial". Khi đó bạn phải thay (cons 7 "1" ) bằng (cons 7 "ahs-Arial") hoặc bạn phải bổ sung cái Style "1" này vào bản vẽ của bạn bạn nhé.

 

Chúc bạn vui.

cảm ơn anh!Em hiểu rồi ạ!Thanks anh nhiều!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
cảm ơn anh!Em hiểu rồi ạ!Thanks anh nhiều!

Chào bạn Truongthanh,

Mình bổ sung đoạn code check style vào trong lisp này. Khi chạy nó sẽ tự kiểm tra xem trong bản vẽ của bạn đã có style "1" hay chưa. Nếu chưa có nó sẽ tạo style "1" giống như cái style "1" mà bạn đang sử dụng trong bản vẽ testnew.dwg. Và như vậy kết quả sẽ luôn hiện tiếng Việt như bạn mong muốn.

Bạn phải cảnh giác nếu như trên file bản vẽ của bạn đã có style "1" nhưng nó lại không phải là font Arial.tif thì text sẽ hiển thị không đúng đâu nhé. Vì thế nên kiểm tra kỹ font text trước khi chạy lisp bạn nhé.

Lisp đây:


(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
        n  (sslength ss)
        i 0
       tnlst (list)
       cnlst (list)
)
(while (        (setq en (ssname ss i)
               els (entget en)
               txt (cdr (assoc 1 els))
       )
       (if  (= (substr txt 1 1) (chr 216))
            (if (wcmatch txt "*-*-*")
               (setq tnlst (append tnlst (list txt)))
               (setq cnlst (append cnlst (list txt)))
            )
        )
        (setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
       (setq chuoi (nth 0 lst))
       (tach chuoi)
       (setq a t1           ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(substr (nth 0 lst) 1 4)
                lst1 (cdr lst)
                lst2 nil
                tdd 0
                lst2 (append lst2 (list (nth 0 lst)))
       )
       (foreach b lst1
                (tach b )
                (if (= t1 a)
                    (setq lst2 (append lst2 (list b )))
                    (setq lst3 (append lst3 (list b )))
                )
       )
       (foreach c lst2
               (tach c )
               (setq tdd (+  tdd (atof t2))
                       lo t1
               )
       )
      (alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2  ) ))
       (setq lst lst3
               lst3 nil 
               cnt (1+ cnt)
       )
      (setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
       p3 (polar p2 0 8)
       p4 (polar p3 0 44)
       p5 (polar p4 0 20)
       p6 (polar p5 0 13)
       p7 (polar p2 (- (/ pi 2)) 5)
       p8 (polar p3 (- (/ pi 2)) 5)
       p9 (polar p4 (- (/ pi 2)) 5)
       p10 (polar p5 (- (/ pi 2)) 5)
       p11 (polar p6 (- (/ pi 2)) 5)
)       
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) )) 
(cons 1 (rtos cnt 2 0))  (cons 8 "ahs-tnt-text") (cons 7 "1") )  )  
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) )) 
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") (cons 7 "1") )  )         
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) )) 
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") (cons 7 "1") )  )  
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) )) 
(cons 1 "m") (cons 8 "ahs-tnt-text") (cons 7 "1") )  ) 
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")       
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
       p3 (polar p1 0 8)
       p4 (polar p3 0 44)
       p5 (polar p4 0 20)
       p6 (polar p5 0 13)
       p7 (polar p1 (- (/ pi 2)) 5)
       p8 (polar p3 (- (/ pi 2)) 5)
       p9 (polar p4 (- (/ pi 2)) 5)
       p10 (polar p5 (- (/ pi 2)) 5)
       p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)  (cons 7 "1")
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text")  )  )         
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) )) 
(cons 1 "TT")  (cons 8 "ahs-tnt-text") (cons 7 "1") )  )  
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) )) 
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") (cons 7 "1") )  )         
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) )) 
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") (cons 7 "1") )  )  
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) )) 
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") (cons 7 "1") )  ) 
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tach (txt / i n k m )
(setq  i 1
        n (strlen txt)
        k nil
) 
(while (         (setq kt (substr txt i 1))
        (if (= kt "-")
            (progn
                    (setq k i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
       t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
       i 1
       m nil
)
(while ( (setq kt (substr t2 i 1))
        (if (= kt "-")
            (progn
                    (setq m i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if m
  (setq t2 (substr t2 1 (- m 2)))
)
)
)

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun chst (name )
;;;;;;;;(setq name (getstring t "\n Nhap ten style: "))
(if (= (tblsearch "style" name) nil)
   (command "style" name "arial" "" 0.8 "" "" "" )
)
)                    

 

Hy vọng bạn sẽ hài lòng.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cho em hỏi có cách nào thay đổi chiều dài 1 đoạn thẳng có sẵn bằng 1 lệnh ko ah?

 

Ví dụ:

- có 1 đường thẳng bất kỳ ( ví dụ dài 1590mm)

- Nhập lệnh Autolisp (ví dụ là lệnh td chẳng hạn )

- Chọn đường thẳng

- Chọn điểm gốc

- Nhập chiều dài cần thay đổi ( ví dụ là 2000 hay 1000 chẳng hạn) thì đường thẳng đó tự động dài ra thành 2000 hay ngắn lại theo số liệu mình nhập.

 

Em cám ơn nhiều.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Cho em hỏi có cách nào thay đổi chiều dài 1 đoạn thẳng có sẵn bằng 1 lệnh ko ah?

 

Ví dụ:

- có 1 đường thẳng bất kỳ ( ví dụ dài 1590mm)

- Nhập lệnh Autolisp (ví dụ là lệnh td chẳng hạn )

- Chọn đường thẳng

- Chọn điểm gốc

- Nhập chiều dài cần thay đổi ( ví dụ là 2000 hay 1000 chẳng hạn) thì đường thẳng đó tự động dài ra thành 2000 hay ngắn lại theo số liệu mình nhập.

 

Em cám ơn nhiều.

Cái này đơn giản nhất quả đất.

Gõ lệnh scale chọn đoạn thẳng chọn điểm gốc xong gõ 2000/1590 để được đoạn 2000 hoặc 1000/1590 để được đoạn 1000. Chúc bạn vui.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Cái này đơn giản nhất quả đất.

Gõ lệnh scale chọn đoạn thẳng chọn điểm gốc xong gõ 2000/1590 để được đoạn 2000 hoặc 1000/1590 để được đoạn 1000. Chúc bạn vui.

Nếu có nhiều đoạn thẳng cần thay đổi như vậy thì nên sử dụng lệnh Len

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×