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

[Tue_NV 3.912]

Các Bác giúp em với.Có Lisp nào chuyển text chữ số có dấu phấy thành dấu chấm ko.

File do day.

http://www.cadviet.com/upfiles/3/drawing2_4.dwg

Dùng lệnh FIND

[ketxu 2.984]

Chào bạn ketxu,

Hề hề hề,

Trên diễn đàn có lisp scale theo một chiều mà, có cả lisp scale theo hai chiều với các tỷ lệ khác nhau nũa cơ mà. Bạn ngâm cứu thử coi. Có khi lại quá đạt yêu cầu thì gay......

Cái PS của bạn có thể làm được nếu bạn ngâm cứu kỹ cái lisp vẽ tường của bác Phamngoctukts ,( cái đoạn trim các đầu mút đó) và ứng dụng vào trường hợp của bạn. Cụ thể là dùng lệnh trim với tùy biến fence bạn ạ.

 

Chúc bạn thành công, nếu có trở ngại hãy post lên nhé.

Tks bác.Đúng là e quên béng mất việc scale 1 chiều ^^.Nhưng gặp đường xiên ấy,thì e k biết sao đây.Hơn nữa trong 1 bv có nhiều cái x,nhiều cái Y.Lần nào dùng xsc e cũng phải chọn xem là x,hay y :|

Đây là ý tuởng hay.

 

1. Từ Cad 2010, có lệnh GeomConstraint (hoặc MENU -> Parametric) có khả năng tạo các Link liên kết các đối tuợng với nhau.

Để hiểu rõ hơn, bạn có thể nghiên cứu các Option của nó GeomConstraint

 

2. Hoặc dùng REACTOR trong VisualLisp để Connect các điểm cuối của các đối tuợng lại với nhau.

tham khảo VD của VUVUZELA connect

Vâng.Sau khi nâng cấp máy e sẽ cài 2010 để nghiên cứu.Máy e cùi quá,dùng thử 2010 n bị giật quá bác ạ

Tiện đây e xin nhờ bác nâng cấp lisp thống kê text bác đã viết trước đây,e muốn text khi export ra sắp xếp theo chiều tăng dần A,B,C và tạo bảng xinh xinh quanh nó thì có được không ạ ?

Thong ke text va viet ra man hinh
(defun c:tkt (/ lst msp pt ss str txtsiz)
(vl-load-com) 
(setvar "Textstyle" "KCVN-COMM")
(if (setq ss (ssget(list (cons 0 "TEXT"))))
(progn
(foreach e (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq str (vla-get-TextString e))
(if (not (assoc str lst))
(setq lst (cons (cons str 1) lst))
(setq lst (subst (cons str (1+ (cdr (assoc str lst))))
(assoc str lst) lst))) )
(setq lst (vl-sort lst '(lambda (x y) (pt (getpoint "\nDiem dat Bang :" )
txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(foreach e lst
(vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz )
(vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz))) ) )
(alert "Khong chon duoc Text.") )
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[phamthanhbinh 3.146]

Chào bác Bình Thấy bác rất nhiệt tình giúp đỡ người khác nên em cũng bắt tay vào nghiên cứu tiếp cái lisp nghe vẻ "xương" này.

Thấy code trên của bác có đoạn (setq ssp (ssget "CP" ptlst (list (cons 0 "POINT"))) em chợt nảy ra một ý như thế này.

1. quét tất cả các đường line, pline trên bản vẽ. chèn point vào các đỉnh line.

2. Vẫn tạo boundary bình thường để lấy các đỉnh của boundary dùng (ssget "cp" các đỉnh này để quét qua các point nằm trên Boundary đó.

3. xuất toạ độ các point. Đến đây thì em bị mắc một chút là chưa biết lọc và loại bỏ các điểm trùng nhau.

đây là code

Chào bác Phamngoctukts,

Bác cứ nói vậy làm mình ..... ngượng chết. Cái lisp này vốn là của bác đó, mình chỉ mót về xào nấu tí ti cho nó thêm tí gia vị cho vừa mồm bạn hdt4151 thôi mà. Bạn ấy còn đang chê khó nuốt đấy bác ạ. Hề hề hề.,....

Về ý tưởng của bác mình thấy có một vài ý kiến như sau:

1/- Quét tất cả các line và lwpolyline trên bản vẽ rồi gắn point cho các đỉnh.

Điều này sẽ tạo ra một khối lượng khá lớn các điểm dư thừa khi có những line không thuộc các cạnh của boundary.

2/- Đây chính là cái mình đã chọn và làm lisp dựa trên đó. Các đỉnh của boundary thì bác đã làm, còn các point khác thì được chọn bởi tập ssp và bác yên tâm là nó chả có thằng nào trùng với các đỉnh boundary được do boundary được tạo sau và bác không hề đặt point vào đó.

Do tập ssp có thể chứa các point không thuộc các cạnh boundary nên mình dùng hàm (vlax-curve-getclosestpointto....) để làm điều kiện kiểm tra xem point có thuộc cạnh của boundary hay không. Nếu point thuộc cạnh tứcboun thỏa điều kiện của hàm (if (equal .......) thì nhét nó vào trong tập hợp dỉnh boundary của bác.

Tiếp theo là dùng hàm (vl-sort ....) để sắp xếp lại trật tự các point và đỉnh dựa vào parameter của các point và đỉnh trên boundary.

Ở đây mình chưa xét tới trường hợp point trùng nhau hay trùng với đỉnh của boundary do ngẫu nhiên như bác.

Có được cái list này rồi thì việc xuất text cứ copy của bác là ngon lành.

Bác xem lisp của mình ở trên sẽ rõ.

3/- Việc lọc các point trùng nhau hay trùng với đỉnh của boundary có thể thực hiện được bằng cách xét parameter của chúng hay xét tọa độ của chúng đồng thời với ename của nó trong một list các point bác ạ Nếu trùng thì bác cứ delete nó khỏi tập chọn là Ok (sử dụng hàm ssdel)

 

Ấy là mình nghĩ vậy chứ chưa làm thử bác ạ. Nếu bác rảnh có thể làm thử theo hướng này xem sao. Mình phải chờ phản hồi từ bạn hdt4151 đã chứ cứ nấu hoài mà người ăn cứ chê hoài thì cũng hết cảm hứng nấu bác ạ.

Hề hề hề.....

 

PS: Xuong xẩu không phải là vấn đề chính vì dân đi mót thì gặm xương là cái chắc, chê thì có mà ăn cám bác ạ. Vấn đề là ở chỗ nấu nướng, người ăn lại khó tính nên chửa biết nấu sao cho vừa miệng họ, hết chữa mặn lại chữa ngọt, rồi sắp tới có thể là cay là chua hay là gì gì đó bác ạ. Đành chờ vậy. Hề hề hề.....

[phamthanhbinh 3.146]

Tks bác.Đúng là e quên béng mất việc scale 1 chiều ^^.Nhưng gặp đường xiên ấy,thì e k biết sao đây.Hơn nữa trong 1 bv có nhiều cái x,nhiều cái Y.Lần nào dùng xsc e cũng phải chọn xem là x,hay y :|

Hề hề hề,

Với đường xiên thì chơi kiểu xiên.

1/- xoay nó về thẳng theo hệ trục

2/- Xoay hệ trục về thẳng theo nó.

Và tất nhiên là sau đó xoay nó trở lại như cũ. Có thể dùng lisp cho vụ này.

Hề hề hề,....

Cái vụ chọn x hay y thì đành chịu, có thể mặc định là x, còn y thì phải chọn, như vậy cũng nhanh hon được tí xíu. Hề hề hề. Ới bác Duy ơi, cứu bồ nè.....

[gia_bach 1.551]

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

Tiện đây e xin nhờ bác nâng cấp lisp thống kê text bác đã viết trước đây,e muốn text khi export ra sắp xếp theo chiều tăng dần A,B,C và tạo bảng xinh xinh quanh nó thì có được không ạ ?

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

Tự hỏi và trả lời.

Lisp này mà có chế độ sắp xếp text,tùy chỉnh textstyle theo 1 text,và kẻ bảng xung quanh thì tuyệt vời ^^..Tks a gia_bach ^^

 

bài viết số 9 : http://www.cadviet.com/forum/index.php?sho...st&p=107988

[ketxu 2.984]

ý,topic kia e post ý kiến xong lâu rồi không vào,thấy diễn đàn k báo bài mới,chắc bị trôi mất.Cảm ơn a gia_bach^^.Nhưng mà anh ơi,e hỏi luôn là với bảng tạo ra,mình làm sao mà change được textstyle,hoặc tabstyle ạ :cheers: E k biết dòng nào trong code quyết định textstyle,thấy nó in ra là StanDARD luôn,muốn chỉnh laiị cực quá :cheers:.

Hề hề hề,

Với đường xiên thì chơi kiểu xiên.

1/- xoay nó về thẳng theo hệ trục

2/- Xoay hệ trục về thẳng theo nó.

Và tất nhiên là sau đó xoay nó trở lại như cũ. Có thể dùng lisp cho vụ này.

Hề hề hề,....

Cái vụ chọn x hay y thì đành chịu, có thể mặc định là x, còn y thì phải chọn, như vậy cũng nhanh hon được tí xíu. Hề hề hề. Ới bác Duy ơi, cứu bồ nè.....

E nghĩ là dùng lisp thì nhanh hơn.Move nó ra theo phương vuông góc với 2 đỉnh line,base point vẫn là điểm pick vào đường giữa.Nhưng bị vướng vấn đề là làm sao tách ra được chú nào ở bên trái line giữa,chú nào bên phải đặng mà move cho đúng hướng :cheers:(

[phamngoctukts 714]

Ấy là mình nghĩ vậy chứ chưa làm thử bác ạ. Nếu bác rảnh có thể làm thử theo hướng này xem sao. Mình phải chờ phản hồi từ bạn hdt4151 đã chứ cứ nấu hoài mà người ăn cứ chê hoài thì cũng hết cảm hứng nấu bác ạ.

Hề hề hề.....

 

PS: Xuong xẩu không phải là vấn đề chính vì dân đi mót thì gặm xương là cái chắc, chê thì có mà ăn cám bác ạ. Vấn đề là ở chỗ nấu nướng, người ăn lại khó tính nên chửa biết nấu sao cho vừa miệng họ, hết chữa mặn lại chữa ngọt, rồi sắp tới có thể là cay là chua hay là gì gì đó bác ạ. Đành chờ vậy. Hề hề hề.....

Nhưng mà lisp của bác báo lỗi không chạy được. Đến bước chọn gốc toạ độ là báo lỗi. Bác xem lại cái nhìn code của bác hoa cả mắt trả biết sai chỗ nào hề hề.

[phamvanthiet108 11]

Dùng lệnh FIND

em làm được rùi cám ơn bác Tue_NV

[hdt4151 1]

@phamthanhbinh: mình cùng ý kiến với bạn phamngoctukts ^^!, vì point không có sẵn mà chỉ có sẵn các đường line, pl giao nhau tạo ra các điểm (srr, lúc trc mình nhầm về vụ point có sẵn hay k bạn đừng giận nhé). Cách tạo point như bạn phamngoctukts rất đúng với ý mình, cứ theo hướng đó nhé (xóa các điểm trùng nhau, xác định thứ tự ..) . Việc tạo ra lisp không chỉ đơn giản là 1 bài toán bình thường, nó có thể giúp việc tính phần mềm của ks nhanh gấp 10 lần :cheers:

[gia_bach 1.551]

@phamthanhbinh: mình cùng ý kiến với bạn phamngoctukts ^^!, vì point không có sẵn mà chỉ có sẵn các đường line, pl giao nhau tạo ra các điểm (srr, lúc trc mình nhầm về vụ point có sẵn hay k bạn đừng giận nhé). Cách tạo point như bạn phamngoctukts rất đúng với ý mình, cứ theo hướng đó nhé (xóa các điểm trùng nhau, xác định thứ tự ..) . Việc tạo ra lisp không chỉ đơn giản là 1 bài toán bình thường, nó có thể giúp việc tính phần mềm của ks nhanh gấp 10 lần :cheers:

 

To : bác Bình.

Cứ thế, cứ theo hướng đó mà đi bác nhé!

Chúc bác "mạnh cái đôi chân" mà đi bác nhỉ! :cheers:

 

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

PS: Xuong xẩu không phải là vấn đề chính vì dân đi mót thì gặm xương là cái chắc, chê thì có mà ăn cám bác ạ. Vấn đề là ở chỗ nấu nướng, người ăn lại khó tính nên chửa biết nấu sao cho vừa miệng họ, hết chữa mặn lại chữa ngọt, rồi sắp tới có thể là cay là chua hay là gì gì đó bác ạ. Đành chờ vậy. Hề hề hề.....

"Chua cay mặn ngọt" ... Hề hề hề.....

[huong259 351]

"Chua cay mặn ngọt" ... Hề hề hề.....

"Chua cay mặn ngọt" gì em không biết

Em chỉ có câu hỏi sao anh không giả nhời câu hỏi của em, hỏi là quyền của em và trả lời cũng là quyền của anh, em ko trách anh đâu em chỉ hỏi để mà hỏi thôi:

http://www.cadviet.com/forum/index.php?sho...=274&st=520

[Tue_NV 3.912]

"Chua cay mặn ngọt" gì em không biết

Em chỉ có câu hỏi sao anh không giả nhời câu hỏi của em, hỏi là quyền của em và trả lời cũng là quyền của anh, em ko trách anh đâu em chỉ hỏi để mà hỏi thôi:

http://www.cadviet.com/forum/index.php?sho...=274&st=520

em chỉ hỏi để mà hỏi thôi nhưng mà nếu anh gia_bach giả nhời thì em sẽ vui hơn hè hè :cheers:

Việc tạo Point là cách hay nhưng nếu tạo point theo cách của bạn Tú là không ổn.

Còn của bác Bình vì các Point không có nên phải vẽ Point, ít thì không sao, nhiều thì mệt chết được. <_>

 

Các bác thử cách không vẽ Point và điểm giao lấy từ các giao điểm của Boundary và các Line hoặc PLINE thử xem. Hề hề, để các bác suy nghĩ thêm :cheers:

[18011985 62]

Bộp Bộp đề nghị trật tự, đề nghị mọi người tranh luận chuyển sang mục khác để tránh làm loãng mục Viết lsp theo yêu cầu. Chân thành cảm ơn. :cheers:

[phamthanhbinh 3.146]

Nhưng mà lisp của bác báo lỗi không chạy được. Đến bước chọn gốc toạ độ là báo lỗi. Bác xem lại cái nhìn code của bác hoa cả mắt trả biết sai chỗ nào hề hề.

Hề hề hề,

Không phải đâu là không phải đâu, thấy bạn hdt4151 hỏi bác trả lời tưởng là bác biết rồi chớ. Tại vì cái điều kiện của lisp này là trong vùng chọn phải có các point rồi. Nếu hổng có là nó đâu có chạy được. Điều này mình đã nói rõ khi post bài rồi mừ ......

Ý của mình đã nói rõ trong bài trả lời bạn hdt4151. Bác chỉ cần point trước vài phát trong các boundary là nó chạy vè vè bác à.

Đây là cái mình đã cho thêm hàm điều kiện if để tránh cái lỗi nớ, đồng thời mình bổ sung luôn cả phần lọc các point trùng nhau hoặc trùng đỉnh boundary như bác đã gợi ý.

Lisp nó như rừng là do viết đi viết lại, thêm mắm thêm muối đó bác, mà mình ngại viết lại từ đầu nên cứ nhè thằng cũ mà thêm thôi. Lại ngại nghỉ tên mới cho các biến nên cứ lặp đi lặp lại mấy cái pd, dp, pt..... làm nó rối thêm bác ạ.

Do là thợ đụng nên đụng dâu sửa đó nó mới thế. Rất mong bác thông cảm.

Tuy nhiên mình cũng đã cố tách bạch nó ra thành từng đoạn với chức năng riêng để dễ theo dõi.

Cụ thể cấu tạo của nó như sau:

1/- Đoạn đầu cho đến dòng code (while (/= p nil) .... là của bác nên chắc bác đã rõ. Mình chỉ bổ sung thêm cái dòng chọn điểm gốc tọa độ và hàm điều kiện cho thằng này là vì yêu cầu của bạn hdt4151 muốn được chọn gốc thoải mái. Đồng thời thêm vô thằng (getvar "ucsorg") để lấy tọa độ của gốc tọa độ người dùng (Cái này cũng là do bạn hdt4151 đẻ ra yêu cầu bổ sung ạ)

2/- Bắt đầu vào vòng lặp để cho người dùng được chọn nhiều vùng cần ghi tọa độ. (while (/= p nil)

2.1/- Bước thứ nhất trong vòng lặp được tính tới lúc kết thúc hàm (while (vlax-.......)Nhằm tạo ra danh sách các tọa độ đỉnh của boundary.

Cái này cũng của bác. Mình chỉ thêm vô tạo cái danh sách dtlist kết hợp giữa vị trí đỉnh hay cũng chính là parameter của đỉnh với tọa độ của nó để sử dụng cho việc dùng vl-sort sau này thôi bác ạ.

2.2/- Bước thứ hai từ hàm (setq ssp (ssget......)) cho đến kết thúc hàm (if ssp........). Ấy là dùng để xác định tập hợp các điểm trong vùng chọn và loại bớt những thằng không nằm trên cạnh boundary, đồng thời gán thêm các cặp (parameter tọa-độ) vào cái dtlst đã được lập ở trên.

2.3/- Bước thứ ba từ (setq dplst (vl-sort....)) cho đến kết thúc hàm (setq dplst dplst1) là để xử lý thằng dtlst này, sắp xếp lại theo tứ tự của parameter và lọc bớt những thằng trùng nhau theo như góp ý của bác.

2.4/- Bước thứ tư từ (setq pdlst (list)) cho tới hết hàm (if (/= ans "N") là mình kế thừa cái lisp của bác nhằm tạo ra các record trong dlst phục vụ cho việc xuất text sau này. Ở đây có hơi khác chút xíu ở chỗ cách tạo ra pdlst. Và cái biến này là mình kế thừa cái pdlst của bác vì lười đặt tên mới. cũng vì lười nên lại đẻ ra cái thằng (setq pdlst (list)) bác ạ, nhằm tránh bị thống kê các đỉnh boundary hai lần.

2.5/- Bước cuối cùng từ (setq pdlst (append pdlst (list (car pdlst)))) cho đến khi kết thúc vòng lặp (while (/= p nil)...) là những cái mình làm thêm do yêu cầu của bạn hdt4151 nhằm chuẩn bị cho vòng lặp tiếp theo.

(setq pdlst (append pdlst (list (car pdlst)))) hàm này để thêm điểm đầu của boundary vào danh sách để phục vụ cho việc ghi text lên cạnh boundary do mình hiểu nhầm khẩu vị của bạn ấy.

(setq dlst (append (list "\n") dlst)) Hàm này nhằm tạo một dòng trống giữa các boundary khác nhau trên file text.

(setq hlst (append hlst (list pdlst))

dplst (list)

ptlst (list)

) ;;;;;;;;;;;;;;;; End setq

Khúc này để tạo một list các point có trên mỗi boundary tách biệt với nhau phục bụ việc ghi text ra bản vẽ và đặt các biến dplst, ptlst về trạng thái ban đầu nhằm tránh việc râu ông nọ cắm cằm bà kia. Hề hề hề.....

3/- Là phần ghi dữ liệu ra file text và ghi lên bản vẽ. bác đã quá rành.

Trong phần này chỉ có lưu ý là mình sử dụng thêm hàm con (wrtxt .....) có thể bị trùng tên với các hàm ghi text ra file chứ không phải vẽ text lên bản vẽ. Vì lười đặt tên bác ạ. Do vậy khi dùng cần tắt các lisp loanh quanh đi kẻo mà trùng tên lệnh thì toi bác ạ.

Thực tế thì cái hàm wrtxt này đã bị mình vô hiệu hóa bằng cách củ chuối rồi. Bác có thể khôi phục nó để test thử coi sao. Vì đã mất công đẻ ra mà lại bóp chết nó nghe hơi buốt ruột nên bác thông cảm nha. Cứ để đó có ai thích thì khôi phục lại dùng chơi bác nhể....

 

Dông dài mãi, Lisp đây bác ạ

;; free lisp from cadviet.com
(defun c:tdd ( / tmp dlst p1 file opw msg id)
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y" 
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
  (setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
        obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
       ptlst (append ptlst (list p1))
       dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax

(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT"))))
(if ssp
    (progn
            (setq n (sslength ssp)
                     j 0
     ) ;;;;;;;;;;;; End setq

(while (        (setq p (cdr (assoc 10 (entget (ssname ssp j ))))
               p0 (vlax-curve-getclosestpointto obj p)
               pa (vlax-curve-getparamatpoint obj p0)
       )
       (if (equal (distance p0 p) 0 0.00001)
                 (setq dplst (append dplst (list (list pa p0))))
       )
       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (        dplst1 (list)
       m (length dplst)
        k 0
)
(while (       (if (/= (car (nth k dplst)) (car (nth (1+ k) dplst)))
          (setq dplst1 (append dplst1 (list (nth k dplst))))
      )
      (setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
       (setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)   
)   ;;;;;;;;;;;;;;;;;End foreach d         

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
       dplst (list)
       ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
       i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
       x  (- (car (nth i lst)) (car pg))
       y  (- (cadr (nth i lst)) (cadr pg))
       z  (- (caddr (nth i lst)) (caddr pg))
       pt (polar (list x y z) (- goc (/ pi 2)) 2)
       i (1+ i)
)
(if (and (> goc (/ pi 2)) ((setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Hề hề hề, mong bác thông cảm chớ có giận mình vì vô duyên. Chúc bác vui.

[phamthanhbinh 3.146]

@phamthanhbinh: mình cùng ý kiến với bạn phamngoctukts ^^!, vì point không có sẵn mà chỉ có sẵn các đường line, pl giao nhau tạo ra các điểm (srr, lúc trc mình nhầm về vụ point có sẵn hay k bạn đừng giận nhé). Cách tạo point như bạn phamngoctukts rất đúng với ý mình, cứ theo hướng đó nhé (xóa các điểm trùng nhau, xác định thứ tự ..) . Việc tạo ra lisp không chỉ đơn giản là 1 bài toán bình thường, nó có thể giúp việc tính phần mềm của ks nhanh gấp 10 lần :cheers:

Chào bạn hdt4151,

Hề hề hề,

Biết ngay cái nhà ông mãnh này mà. Đã bảo nghĩ cho kỹ trước khi hỏi thì không nghe. Khi người ta hỏi point đã có chưa thì bảo point đã có sẵn.

Các điểm đó do người khác tạo ra có sẵn từ trước, vấn đề đau đầu chình là thứ tự của điểm đó.

- Giả sử đa giác có n cạnh và có m số điểm nằm trên cạnh của đa giác.

Cho i:=1 to m

j:=1 to n

+ Xác định được m điểm nằm trên cạnh đa giác với mã dxf = 0 !?

+ Xét cạnh 1 : Tìm toạ độ 2 điểm đầu, cuối của cạnh 1 : x1 y1 x2 y2 => dx = x1-x2 dy = y1-y2

Phương trình của cạnh 1 là : y =kx (k=dx/dy)

Nếu điểm thứ i có x2>xi>x1 (với x2>x1) => xét xem nếu yi = k.xi => điểm i thuộc cạnh 1 .Nếu yi # k.xi => điểm i không thuộc cạnh 1 => Xét cạnh 2 => ....=> xét cạnh thứ n.

 

Bạn xem giải thuật này có thể thực hiện được k ?

Hình minh hoạ

http://www.cadviet.com/upfiles/3/c.dwg

Bây giờ lại quay ngược lại 180 độ với một lời xin lỗi. Hề hề hề. mình có lỗi đâu mà cho bạn được. Vị này có khi còn cay hơn ớt nhiếu các bác nhỉ?????

 

Bạn có hiểu rằng chỉ vì cái thiếu suy nghĩ của bạn mà khiến nhiều người khác phải đau đầu không nhỉ ??? Sự vô tâm của bạn sẽ trở thành ích kỷ và thậm chí là độc ác nữa đó nếu bạn không tự điều chỉnh lấy cách làm việc và cách suy nghĩ bạn ạ. Bạn cần tôn trọng sự lao động của người khác cũng như chính sự lao động của bạn . Là một cán bộ kỹ thuật mà suy nghĩ hời hợt , trình bày vấn đề không rõ ràng khiến mọi người hiểu lầm thì sẽ có ngày bạn phải trả giá không nhỏ đâu. Mình thật sự không hài lòng về cái cách suy nghĩ và làm việc của bạn. Cho dù đây là diễn đàn mở và dành cho tất cả mọi người nhưng không có nghĩa là không cần đến sự thận trọng và cân nhắc khi trình bày yêu cầu của mình. Bạn chỉ có thể có được một đáp án hoàn chỉnh và tối ưu khi bạn trình bày vấn đề một cách hoàn chỉnh và mạch lạc, dễ hiểu nhất. Hơn thế nữa bạn phải thể hiện được sự cầu thị, mong muốn tiên bộ của bạn, chứ không phải với cái cách quăng vấn đề ra vô tội vạ như vậy.

 

Đúng là việc dùng lisp có thể giúp công việc nhanh hơn nhiều lần, song đó chỉ là đối với những người có kiến thức về lisp thôi. Còn với những người chỉ chuyên đi copy về xài thì chưa chắc đâu. Nhiều khi nó còn gây hại nữa đấy. Việc diễn đàn mở topic viết lisp theo yêu cầu cũng chỉ nhằm mục tiêu giúp đỡ những người muốn học lisp để vận dụng nó cho công việc của mình chứ hoàn toàn không phải là để làm hộ công việc của mọi người. Các lisp có sẵn tuy đã rất nhiều, nhưng không phải ai cũng có thể vận dụng được nó bạn ạ. Nếu bạn không học nó thì cho dù trong tay bạn có hàng ngàn cái lisp bạn cũng vẫn chả thể làm nhanh hơn do yêu cầu công việc luôn luôn đổi mới mà các lisp có sẵn thì ít khi đáp ứng đầy đủ. Vì thế bạn phải cải tiến hoàn thiện thêm cho nó mới được bạn ạ.

 

Cách mót của mình cũng vậy thôi, mót cái có sẵn về xào nấu sao cho hợp khẩu vị của mình thì xài bạn ạ. Cái lisp mình viết cho bạn cũng là xào nấu từ các lisp có sẵn thôi chứ chả phải tốn kém bao nhiêu cả. Vấn đề là phải hiểu nó mới xào nấu cho ngon được.

 

Về ý kiến của bác Phamngoctukts thì mình đã trả lời, bạn đọc thêm ở đó. Riêng mình thì nghĩ nếu đó đúng là yêu cầu của bạn, có thể sẽ dùng lisp tìm giao điểm của boundary với các đối tượng khác rồi sau đó làm tương tự như cái lisp của mình là OK.

 

Hãy chờ đó.

[huong259 351]

em chỉ hỏi để mà hỏi thôi nhưng mà nếu anh gia_bach giả nhời thì em sẽ vui hơn hè hè :cheers:

Vâng ạ! Anh nói trúng ý của em!

[phamthanhbinh 3.146]

Nhưng mà lisp của bác báo lỗi không chạy được. Đến bước chọn gốc toạ độ là báo lỗi. Bác xem lại cái nhìn code của bác hoa cả mắt trả biết sai chỗ nào hề hề.

Chào bác phamngoctukts,

Cái lisp này cải biên từ cái lisp trước, lần này nó không chon point có sẵn nữa mà chọn các đối tượng giao với boundary để xác định point. Sau đó thì làm y như cụ bác ạ.

Một vấn đề mà mình chưa gỡ được chính là việc chọn các đối tượng. Mình đã thử dùng hàm ssget với tùy chọn là "CP" nhưng nó chọn không hết các đối tượng giao với boundary. Vì sao thì mình chưa rõ. Vậy nên lại chơi bài củ chuối là pick chọn đối tượng thì nó lại chạy rất chuẩn. cách pick chọn này mà vớ phải dăm chục anh loằng ngoằng thì cũng mệt, xong mình chưa tìm ra cách chọn nào để có thể chọn tất cả các đối tượng giao với boundary cả bác ạ. (Bác xem trên cái líp của mình sẽ rõ)

Hy vọng bác tìm ra cách chọn có hiệu quả hơn cách của mình.

Chúc bác vui.

Lísp đây ạ

;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name 
                     obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y" 
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
  (setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
        obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
       ptlst (append ptlst (list p1))
       dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax

;;;;;;;;;;;;;;(setq ssp (ssget "CP" ptlst (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
(alert "\n Chon cac doi tuong giao voi boundary ")
(setq ssp (ssget ))
(if ssp
    (progn
            (setq n (sslength ssp)
                     j 0
     ) ;;;;;;;;;;;; End setq

(while (        (setq ent (ssname ssp j)
               p0 (giao ent name)
               pa (vlax-curve-getparamatpoint obj p0)
       )
       (setq dplst (append dplst (list (list pa p0))))

       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (        dplst1 (list)
       m (length dplst)
        k 0
)
(while (       (if (/=  (car (nth k dplst)) (car (nth (1+ k) dplst)) )
          (setq dplst1 (append dplst1 (list (nth k dplst))))
      )
      (setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
       (setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)   
)   ;;;;;;;;;;;;;;;;;End foreach d         

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
       dplst (list)
       ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
       i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
       x  (- (car (nth i lst)) (car pg))
       y  (- (cadr (nth i lst)) (cadr pg))
       z  (- (caddr (nth i lst)) (caddr pg))
       pt (polar (list x y z) (- goc (/ pi 2)) 2)
       i (1+ i)
)
(if (and (> goc (/ pi 2)) ((setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename 
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
     ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq g (vlax-safearray->list g))
   (setq g nil)
)
(if g
   (progn
         (setq kq nil
               sd (fix (/ (length g) 3))
         )
         (repeat sd
                 (setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
                       g (cdddr g)
                 )
         )
         kq
    )
    nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[phamthanhbinh 3.146]

Chào bác phamngoctukts,

Cái lisp này cải biên từ cái lisp trước, lần này nó lkho6ng chon point có sẵn nữa mà chọn các đối tượng giao với boundary để xác định point. Sau đó thì làm y như cụ bác ạ.

Một vấn đề mà mình chưa gỡ được chính là việc chọn các đối tượng. Mình đã thử dùng hàm ssget với tùy chọn là "CP" nhưng nó chọn không hết các đối tượng giao với boundary. Vì sao thì mình chưa rõ. Vậy nên lại chơi bài củ chuối là pick chọn đối tượng thì nó lại chạy rất chuẩn. cách pick chọn này mà vớ phải dăm chục anh loằng ngoằng thì cũng mệt, xong mình chưa tìm ra cách chọn nào để có thể chọn tất cả các đối tượng giao với boundary cả bác ạ. (Bác xem trên cái líp của mình sẽ rõ)

Hy vọng bác tìm ra cách chọn có hiệu quả hơn cách của mình.

Chúc bác vui.

Lísp đây ạ

Hề hề hề,

Có giải pháp rồi, không phải pick từng chú nữa. sử dụng hàm ssget với tùy chọn "C" . Tuy nhiên để dùng tùy chọn này phải có hai điểm của khung chọn, do vậy mình xài hàm acet-ent-geomextents có trong bộ express tool để có được hai điểm đó.

Các bác xem nha.

;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name 
                     obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y" 
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
  (setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
        obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
       ptlst (append ptlst (list p1))
       dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax
(setq dd (car (acet-ent-geomextents name))
       cc (cadr (acet-ent-geomextents name))
)
(setq ssp (ssget "C"  dd cc (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
;;;;;;;;;;;;;;(alert "\n Chon cac doi tuong giao voi boundary ")
;;;;;;;;;;;;;;(setq ssp (ssget ))
(if ssp
    (progn
            (setq n (sslength ssp)
                     j 0
     ) ;;;;;;;;;;;; End setq

(while (        (setq ent (ssname ssp j))
       (if (/= ent name)
               (setq p0 (giao ent name)
                       pa (vlax-curve-getparamatpoint obj p0))
       )
       (setq dplst (append dplst (list (list pa p0))))

       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (        dplst1 (list)
       m (length dplst)
        k 0
)
(while (       (if (not (equal (car (nth k dplst)) (car (nth (1+ k) dplst)) 0.0000001) )
          (setq dplst1 (append dplst1 (list (nth k dplst))))
      )
      (setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
       (setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)   
)   ;;;;;;;;;;;;;;;;;End foreach d         

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
       dplst (list)
       ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
       i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
       x  (- (car (nth i lst)) (car pg))
       y  (- (cadr (nth i lst)) (cadr pg))
       z  (- (caddr (nth i lst)) (caddr pg))
       pt (polar (list x y z) (- goc (/ pi 2)) 2)
       i (1+ i)
)
(if (and (> goc (/ pi 2)) ((setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename 
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
     ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq g (vlax-safearray->list g))
   (setq g nil)
)
(if g
   (progn
         (setq kq nil
               sd (fix (/ (length g) 3))
         )
         (repeat sd
                 (setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
                       g (cdddr g)
                 )
         )
         kq
    )
    nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[phamngoctukts 714]

Hề hề hề,

Có giải pháp rồi, không phải pick từng chú nữa. sử dụng hàm ssget với tùy chọn "C" . Tuy nhiên để dùng tùy chọn này phải có hai điểm của khung chọn, do vậy mình xài hàm acet-ent-geomextents có trong bộ express tool để có được hai điểm đó.

Các bác xem nha.

;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name 
                     obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y" 
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
  (setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
        obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
       ptlst (append ptlst (list p1))
       dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax
(setq dd (car (acet-ent-geomextents name))
       cc (cadr (acet-ent-geomextents name))
)
(setq ssp (ssget "C"  dd cc (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
;;;;;;;;;;;;;;(alert "\n Chon cac doi tuong giao voi boundary ")
;;;;;;;;;;;;;;(setq ssp (ssget ))
(if ssp
    (progn
            (setq n (sslength ssp)
                     j 0
     ) ;;;;;;;;;;;; End setq

(while (< j n)
       (setq ent (ssname ssp j))
       (if (/= ent name)
               (setq p0 (giao ent name)
                       pa (vlax-curve-getparamatpoint obj p0))
       )
       (setq dplst (append dplst (list (list pa p0))))

       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (<= (car x1) (car x2))))
       dplst1 (list)
       m (length dplst)
        k 0
)
(while (< k m)
      (if (not (equal (car (nth k dplst)) (car (nth (1+ k) dplst)) 0.0000001) )
          (setq dplst1 (append dplst1 (list (nth k dplst))))
      )
      (setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
       (setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)   
)   ;;;;;;;;;;;;;;;;;End foreach d         

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
       dplst (list)
       ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
       i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
       x  (- (car (nth i lst)) (car pg))
       y  (- (cadr (nth i lst)) (cadr pg))
       z  (- (caddr (nth i lst)) (caddr pg))
       pt (polar (list x y z) (- goc (/ pi 2)) 2)
       i (1+ i)
)
(if (and (> goc (/ pi 2)) (<= goc (* 3 (/ pi 2))) )
(setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename 
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
     ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq g (vlax-safearray->list g))
   (setq g nil)
)
(if g
   (progn
         (setq kq nil
               sd (fix (/ (length g) 3))
         )
         (repeat sd
                 (setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
                       g (cdddr g)
                 )
         )
         kq
    )
    nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Hề hề chào bác Bình hôm qua kiểm tra code của bác thấy lỗi đó mà em cũng không biết khắc phục thế nào. sử dụng ở bản vẽ khác thì OK nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì vậy em đã tiếp tục phát triển lisp trên theo hướng add point vào các đỉnh và được code như thế này. Nghe có vẻ ngắn hơn của bác nhưng thời gian thì khỏi phải bàn. Với thế hệ máy tính bây giờ thì có lẽ không thành vấn đề với lisp này mà dùng với thế hệ máy ngày xua p1, p2 với số lượng obj nhiều nhiều một chút chắc là đơ luôn.

Bạn hdt4151 dùng thử 2 lisp xem có thấy sự khác biệt gì không nhé.

;; free lisp from cadviet.com
(defun c:tdd ()
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
ssl (ssget "x" '((0 . "line,lwpolyline")))
)
(setvar "osmode" 0)
(if (= pw nil)   (setq pW (list 0 0 0)))
(while (< k (sslength ssl))
(setq pp1 (cdr (assoc 10 (entget (ssname ssl k))))
pp2 (cdr (assoc 11 (entget (ssname ssl k)))))
(command "point" pp1 "point" pp2)
(setq k (1+ k))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast) 
i 0
ptlst nil
obj (vlax-ename->vla-object name))
(while (/= (vlax-curve-getPointAtParam obj i) nil)
(setq p2 (vlax-curve-getPointAtParam obj i)        
ptlst (append (list p2) ptlst)
i (1+ i))
)
(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT")))
        n (sslength ssp)
        j 0
)
(setq dlst1 (append (list (strcat "hinh thu: "  (rtos id 2 0))) dlst1))
(while (< j n)
(setq p1 (cdr (assoc 10 (entget (ssname ssp j)))))
(setq e 0)
(repeat (length dlst1)
(if (equal (nth e dlst1) (strcat (rtos (car p1) 2 3) "\t" (rtos (cadr p1) 2 3)) 0.01)
(setq p1 (list 0 0 0))
)
(setq e (1+ e))
)
(if (/= (car p1) 0)
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
)
(setq j (1+ j))
)
(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
)
(command "erase" name "")
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq sspt (ssget "x" '((0 . "point"))))
(command "erase" sspt "")
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

[Tue_NV 3.912]

Hề hề chào bác Bình hôm qua kiểm tra code của bác thấy lỗi đó mà em cũng không biết khắc phục thế nào. sử dụng ở bản vẽ khác thì OK nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì vậy em đã tiếp tục phát triển lisp trên theo hướng add point vào các đỉnh và được code như thế này. Nghe có vẻ ngắn hơn của bác nhưng thời gian thì khỏi phải bàn. Với thế hệ máy tính bây giờ thì có lẽ không thành vấn đề với lisp này mà dùng với thế hệ máy ngày xua p1, p2 với số lượng obj nhiều nhiều một chút chắc là đơ luôn.

Bạn hdt4151 dùng thử 2 lisp xem có thấy sự khác biệt gì không nhé.

;; free lisp from cadviet.com
(defun c:tdd ()
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
ssl (ssget "x" '((0 . "line,lwpolyline")))
)
(setvar "osmode" 0)
(if (= pw nil)   (setq pW (list 0 0 0)))
(while ((setq pp1 (cdr (assoc 10 (entget (ssname ssl k))))
pp2 (cdr (assoc 11 (entget (ssname ssl k)))))
(command "point" pp1 "point" pp2)
(setq k (1+ k))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast) 
i 0
ptlst nil
obj (vlax-ename->vla-object name))
(while (/= (vlax-curve-getPointAtParam obj i) nil)
(setq p2 (vlax-curve-getPointAtParam obj i)        
ptlst (append (list p2) ptlst)
i (1+ i))
)
(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT")))
        n (sslength ssp)
        j 0
)
(setq dlst1 (append (list (strcat "hinh thu: "  (rtos id 2 0))) dlst1))
(while ((setq p1 (cdr (assoc 10 (entget (ssname ssp j)))))
(setq e 0)
(repeat (length dlst1)
(if (equal (nth e dlst1) (strcat (rtos (car p1) 2 3) "\t" (rtos (cadr p1) 2 3)) 0.01)
(setq p1 (list 0 0 0))
)
(setq e (1+ e))
)
(if (/= (car p1) 0)
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
)
(setq j (1+ j))
)
(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
  (progn
  (setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
           i 0)
  )
  (setq p nil)
)
(command "erase" name "")
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq sspt (ssget "x" '((0 . "point"))))
(command "erase" sspt "")
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

Chào bạn PhamNgocTu

Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn

Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :

(ssget "CP" ptlst (list (cons 0 "POINT")))

và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

 

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

 

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.

Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:

[phamngoctukts 714]

Chào bạn PhamNgocTu

Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn

Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :

(ssget "CP" ptlst (list (cons 0 "POINT")))

và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

 

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

 

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.

Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:

Chào bác Tue_VN.

Viêc lọc các point có sẵn trên bản vẽ để không bị xoá mất cũng như chọn nhầm thì không khó. Nhưng khi hoàn thành rồi em mới phát hiện ra một nhược điểm là nếu các line này chỉ cắt nhau mà các đỉnh của line này không trùnh nhau thì lisp chạy không đúng. Còn trong file bạn hdt4151 gửi lên thì với lisp lúc trước của bác bình port lên chạy bị thiếu các đỉnh dùng command select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh tiếp xúc với đa giác được (cái này bác có thể giải thích cho em được không). Thank Bác.

[phamthanhbinh 3.146]

Chào bạn PhamNgocTu

Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn

Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :

(ssget "CP" ptlst (list (cons 0 "POINT")))

và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

 

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

 

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.

Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:

Chào bác Tue_NV,

Rất cám ơn bác đã có những lời động viên khích lệ đúng lúc.

Về cái vụ pline có phân đoạn ARC thực tế mình cũng chưa thử, song thiển nghĩ là lisp mình viết vẫn có thể thích ứng do mình phân tích như sau:

1/- Pline có các phân đoạn ARC thì khi dùng lệnh Boundary thì nó vẫn lấy ra được hoán toàn các phân đoạn này và các đỉnh của boundary cũng sẽ lấy được bác ạ. Chỉ có duy nhất một chỗ mình hơi nghi ngờ là các parameter có còn đúng nữa hay không mà thôi.

2/- Về cách xác định các điểm giao cắt thì mình dùng hàm lấy giao điểm của các đối tượng với nhau bất kể đó là đối tương gì trong các đối tượng line. poplyline, lwpolyline, arc, circle, arc , ellipse. Do vậy chắc chắn nó sẽ lấy được giao điểm nếu có. Chỉ còn một lỗi là nó chỉ lấy được một giao điểm trong khi các arc, circle và ellipse thì lại có thể có hai giao điểm với boundary. Về vấn đề này mình cũng đã nghĩ đến, song thiệt nghĩ có nhẽ cũng hiếm gặp nên không tìm cách giải quyết mà nghĩ rằng nếu gặp vậy thì phải break các đường đó ra thành hai đoạn sẽ đơn giản hơn.

Do mình sử dụng cái hàm tìm giao điểm mót được trên diễn đàn nên cũng không biết cách sửa nó để có thể đạt được yêu cầu tìm hết cả các giao điểm của các đường cong.

3/- Việc tập hợp các điểm giao cắt và các đỉnh theo mình là đã xử lý được vấn đề tránh sự trùng lặp nên sẽ không có vấn đề khi ghi ra file nữa.

 

Cuối cùng, nếu bác không bận lắm có thể gợi ý cho mình cái giải pháp để hoàn thiện cái lisp trên được không.

Cám ơn bác nhiều

[hdt4151 1]

Vì phần mềm mình sử dụng không có chức năng nhập đường cong (arc & spline) nên chỉ dùng Polyline và Line , mình dùng Lisp của bạn Bình chạy ra kết quả rất chính xác, việc viết lisp có thể kết thúc ở đây đc rồi. Thanks 2 bác Bình và Tú rất nhiều ^__^

 

1 yêu cầu khác (theo như bác Tue_VN nói là lại sinh ra "1 quả trứng vàng khác", hy vọng không ai ném đá mình, hux #___#) là cho sẵn file hình vẽ, không cần pick điểm, lisp tự động pick nhận diện được tất cả các đường boundary và xuất ra toạ độ như vừa rồi, không biết việc này có dễ thực hiện k !? (trường hợp số boundary >50) , trường hợp này rất hiếm gặp nhưng giải quyết được thì bài toán sẽ tự động hoàn toàn, nếu giúp được thì giúp mình luôn nhé :cheers:

[phamngoctukts 714]

Vì phần mềm mình sử dụng không có chức năng nhập đường cong (arc & spline) nên chỉ dùng Polyline và Line , mình dùng Lisp của bạn Bình chạy ra kết quả rất chính xác, việc viết lisp có thể kết thúc ở đây đc rồi. Thanks 2 bác Bình và Tú rất nhiều ^__^

 

1 yêu cầu khác (theo như bác Tue_VN nói là lại sinh ra "1 quả trứng vàng khác", hy vọng không ai ném đá mình, hux #___#) là cho sẵn file hình vẽ, không cần pick điểm, lisp tự động pick nhận diện được tất cả các đường boundary và xuất ra toạ độ như vừa rồi, không biết việc này có dễ thực hiện k !? (trường hợp số boundary >50) , trường hợp này rất hiếm gặp nhưng giải quyết được thì bài toán sẽ tự động hoàn toàn, nếu giúp được thì giúp mình luôn nhé :cheers:

Bạn dùng code này đi

(if (tạo boundary trước)

(xuất toạ độ là ok)

(bó tay)

)

[hdt4151 1]

Bạn dùng code này đi

(if (tạo boundary trước)

(xuất toạ độ là ok)

(bó tay)

)

 

Bài đầu tiên minh post ở Topic ngoài chính là bài toán tổng quát nhất ^^

1. Chọn tất cả boundary

2. Xuất ra toạ độ

3. Đặt tên từng điểm cho tất cả các điểm, chuyển toạ độ ở bước 2 thành tên điểm

 

Nếu để 1 bài toán lớn như vậy sẽ rất khó giải quyết, Lisp các bạn vừa giúp mình giải quyết được 1/3 bước của bài toán (nhưng chiếm 95% công việc), bước 1 tạm thời dùng theo thủ công (pick điểm), còn bước 3 mình giải quyết bằng Excel (chưa đc hoàn chỉnh lắm về thuật toán). Một lần nữa cám ơn các bạn rất nhiều :cheers: