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

[Tue_NV 3.912]

Ah, lúc đó mình chạy lisp cũng bị lỗi nên xem file lisp trước để sửa lại ^^!

 

@phamthanhbinh: Hôm nay mình dùng lisp vào công việc thì phát sinh 1 lỗi (của công việc), nếu không khắc phục thì ko thể ứng dụng được :cheers: Đó là ngoài việc xuất ra (theo thứ tự) toạ độ các đỉnh của đa giác (được tạo ra bởi lệnh boundary) thì còn phải xuất ra toạ độ của các điểm (nếu có) nằm trên cạnh của đa giác đó.

Bạn giúp mình được ko :cheers:

 

Hình minh hoạ: http://www.cadviet.com/upfiles/3/b.dwg

Tue_NV thấy cái này cũng đơn giản thôi. Bạn dựa vào 2 Lisp viết sẵn cho bạn

1. Là Lisp "bẻ gãy" đối tượng tại các giao điểm mà anh giabach đã post

2. Là Lisp mà bác Bình đã viết

[phamthanhbinh 3.146]

Ah, lúc đó mình chạy lisp cũng bị lỗi nên xem file lisp trước để sửa lại ^^!

 

@phamthanhbinh: Hôm nay mình dùng lisp vào công việc thì phát sinh 1 lỗi (của công việc), nếu không khắc phục thì ko thể ứng dụng được :cheers: Đó là ngoài việc xuất ra (theo thứ tự) toạ độ các đỉnh của đa giác (được tạo ra bởi lệnh boundary) thì còn phải xuất ra toạ độ của các điểm (nếu có) nằm trên cạnh của đa giác đó.

Bạn giúp mình được ko :cheers:

 

Hình minh hoạ: http://www.cadviet.com/upfiles/3/b.dwg

Chào bạn hdt4151,

Do file bạn gửi không load về được nên mình tự hiểu và điều chỉnh cái lisp cũ theo các yêu cầu mới của bạn. Bạn dùng thử và cho ý kiến nhé

Trong lisp này mình đã bổ sung phần loại bỏ sai lệch do người dùng chuyển hệ tọa độ.

;; 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)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
  (setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast))
(while (/= (vlax-curve-getPointAtParam (vlax-ename->vla-object name) (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam (vlax-ename->vla-object name) i)
dlst (append (list (strcat (rtos (- (car p1) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr p1) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr p1) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
ptlst (append ptlst (list p1))
)
(setq i (1+ i))
)
(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)
)
(setq ptlst (append ptlst (list (car ptlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list ptlst))
       ptlst (list)
)
(command "erase" name "")
)
(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 (ptlst / )
(setq n (length ptlst)
       i 0)
(repeat (1- n)
(setq goc (angle (nth i ptlst) (nth (1+ i) ptlst))
       x  (- (car (nth i ptlst)) (car pg))
       y  (- (cadr (nth i ptlst)) (cadr pg))
       z  (- (caddr (nth i ptlst)) (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) ")" ) )
)
)

 

PS: có thể về chiều cao text chưa phù hợp với yêu cầu của bạn, bạn hãy tự điều chỉnh chiều cao này trong dòng code ghi text nhé. Lưu ý khi chỉnh sửa chiều cao này cần chú ý tới việc điều chỉnh vị trí của điểm đặt của text bạn nhé. Vị trí này chính là điểm pt trong lisp. Mong bạn cố gắng tự sửa những điểm nhỏ nhặt nói trên để sử dụng lisp được hiệu quả.

[hdt4151 1]

@phamthanhbinh: bạn hiểu nhầm mình rồi, ý mình như ý bác Tue_VN đã nói trên. Tức là xuất thêm tọa độ các điểm nằm trên cạnh của đa giác (Srr gần đây mình nói toàn dễ gây hiểu lầm) , không cần phải xuất text ra màn hình :cheers:

 

http://i860.photobucket.com/albums/ab170/hdt194_1/hv.jpg

 

Theo như hình minh họa trên là xuất thêm tọa độ các trung điểm của hình vuông (vẫn theo thứ tự tạo nên đa giác như ban đầu)

[Tue_NV 3.912]

@phamthanhbinh: bạn hiểu nhầm mình rồi, ý mình như ý bác Tue_VN đã nói trên. Tức là xuất thêm tọa độ các điểm nằm trên cạnh của đa giác (Srr gần đây mình nói toàn dễ gây hiểu lầm) , không cần phải xuất text ra màn hình :cheers:

 

http://i860.photobucket.com/albums/ab170/hdt194_1/hv.jpg

 

Theo như hình minh họa trên là xuất thêm tọa độ các trung điểm của hình vuông (vẫn theo thứ tự tạo nên đa giác như ban đầu)

Hì hì, rõ khổ, Nâu nâu bạn lại "đẻ 1 cục trứng vàng" kiểu này khổ lắm bạn ạ.

Bạn hãy khái quát lại bài toán của mình. Còn điều kiện gì bổ sung nốt nhé

Bài toán của bạn bổ sung là thêm tọa độ trên boundary (bất kì) chứ không nhất thiết là nằm trên trung điểm phải không?

có điều kiện gì nữa không bạn?

 

Trong lúc chờ đợi viết Lisp theo ý của bạn, Bạn hãy sử dụng cách của Tue_NV

[hdt4151 1]

@Tue_NV: vâng, bài toán khái quát là bổ sung thêm tọa độ của điểm bất kì trên cạnh của boundary (trung điểm chỉ là ví dụ của hình mình post thôi). Không còn điều kiện gì nữa đâu.

 

(- Còn 1 quả trứng khó xơi hơn "quả trứng vàng" này nữa, là tự xác định tất cả các boundary, không phải làm thủ công là pick điểm để xác định boundary, mình nói vậy thôi, bạn cứ giúp mình bài trên đã nhé ^^~)

[phamthanhbinh 3.146]

@phamthanhbinh: bạn hiểu nhầm mình rồi, ý mình như ý bác Tue_VN đã nói trên. Tức là xuất thêm tọa độ các điểm nằm trên cạnh của đa giác (Srr gần đây mình nói toàn dễ gây hiểu lầm) , không cần phải xuất text ra màn hình :cheers:

 

http://i860.photobucket.com/albums/ab170/hdt194_1/hv.jpg

 

Theo như hình minh họa trên là xuất thêm tọa độ các trung điểm của hình vuông (vẫn theo thứ tự tạo nên đa giác như ban đầu)

Chào bạn hdt4151,

Vậy là cái lisp của mình không xài được rồi. Nếu bạn không thích thì cho nó vào sọt rác cho đỡ rối bạn ạ.

Vấn đề của bạn là phẫi xác định được các điểm nằm trên các cạnh, và phải xếp các điểm đó theo đúng trật tự tạo cạnh của lệnh boundary, hề hề hề... không dễ mần. Tuy nhiên không phải không làm được. Cách làm bác Tue_NV đã góp ý là dùng lệnh break của bác Gia bach để bẻ các đoạn thẳng cạnh của boundary tại các điểm bạn khoái và nhét nó vào đúng vị trí trong danh sách các điểm của bạn. Sau đó dùng đoạn lisp xuất ra text là OK

Ngoài ra bạn cũng có một cách nông dân một chút là chịu khó mà ngồi pick từng thằng để nhét nó vào danh sách. Khà khà, cách này tuy chuối nhưng dảm bảo đúng ý bạn pick, chả sợ nhầm nhọt gì. Hề hề hề....

Túm lại là cách thì có không ít, nhưng khoái cái gì thì bạn chọn cái đó căn cứ vào ưu nhược điểm của mỗi cách mà chọn. Nếu bạn hiểu chút ít về lisp thì bạn hoàn toàn chủ động được trong những việc kiểu này bạn ạ. Bạn sẽ hiểu đúng ý của bạn nhất và chả phải làm đi làm lại, chờ đợi hay giải thích gì cho mất công cả. Vậy nên hãy cố gắng học lisp đi bạn ạ.

Còn cái vụ này, bạn phải cho biết các điểm nằm trên cạnh mà bạn nói được xác định theo nguyên tắc nào thì mới có thể làm lisp được bạn ạ. Hề hề hề.......

[hdt4151 1]

@phamthanhbinh: để xác định các điểm đó có thể dùng bất cứ cách nào (trừ việc pick từng điểm #__#) , mình đang nghĩ thuật toán có thể là:

 

+1: lần lược quét từng cạnh của đa giác, dùng 1 hàm nào đó tìm những điểm thuộc cạnh đó

+2: quét tất cà các điểm có trong hình, dùng 1 hàm nào đó để kiểm tra xem điểm đó có thuộc boundary hay không => xác định đ' thuộc cạnh nào

....

Mình sẽ cố gắng học thêm về lisp nữa

[svba1608 627]

Em theo dõi hình vẽ này.

Anh tin em sẽ làm được

Chúc thành công :cheers:

Em chú ý rằng filter với cách như trên : là chọn không phải theo cặp như em mong muốn đâu nhé. Em thử là biết liền

Nếu muốn chọn theo cặp -> chỉ có thể dùng Lisp mà thôi. Hơi bị khó vì các Text của em sắp xếp không theo 1 quy luật nào cả

Chào svba1608

Bạn thử chạy LISP filterTxt .

Kết quả sẽ lọc các cặp TEXT "UBND" và "Phường Đằng Lâm" ra Layer có tên LayerFilter.

Cảm ơn anh Tue_NV và anh gia_bach nhiều nhiều nhiều thật là nhiều!

 

@anh Tue_NV:

Em đã làm theo cách của anh hướng dẫn, kết quả là lọc được ra rất nhiều cặp text "UBND" và "phường Đằng Lâm", nhưng ngoài ra còn lọc ra các text "UBND" và "phường Đằng Lâm" rời rạc, không phải là một cặp, có cách nào giải quyết dứt điểm việc này không anh?

(anh đừng có tin là em sẽ làm được, nhỡ em không làm được thì sao)

 

@anh gia_bach: hiện tại cad của em đang bị: Unknown command "FILTERTXT", khi nào thực hiện được em sẽ báo kết quả lại sau.

Chân thành cảm ơn các anh!

[minhvanvui 1]

Hiệu chỉnh text hàng loạt

--------------------------------------------------------------------------------

 

Chuyện là như thế này :

Bây giờ mình có nhiều text có nội dung khác nhau hoặc giống nhau cũng được , nhưng mình muốn chuyển hết tấc cả nội dung của các text đó về một nội dung trong cùng một lúc. Ví dụ ( text1 = a , text2 = b , text3 = c ,.....) và mình muốn thay đổi các text đó về cùng một nội dung chứ không còn là a,b,c nữa nhưng chỉ trong một lần chỉnh duy nhất là nội dung của hàng loat các đối tượng được chọn đều thay đổi giống nhau.

Mình có gặp một ông KTS sử dụng R14 và ổng dùng lệnh này rất hay nhưng khi mình có ý muốn hỏi xin thì ổng nói là khi ổng viết chỉ sài được trên R14 thôi . Nên mình bâng khuân mãi mà không có được câu trả lời nay nhờ các Pro chỉ giáo giúp và nếu được có thể cho mình lisp của lệnh trên luôn xin cảm ơn nhiều.

[duy782006 1.550]

Hiệu chỉnh text hàng loạt

--------------------------------------------------------------------------------

 

Chuyện là như thế này :

Bây giờ mình có nhiều text có nội dung khác nhau hoặc giống nhau cũng được , nhưng mình muốn chuyển hết tấc cả nội dung của các text đó về một nội dung trong cùng một lúc. Ví dụ ( text1 = a , text2 = b , text3 = c ,.....) và mình muốn thay đổi các text đó về cùng một nội dung chứ không còn là a,b,c nữa nhưng chỉ trong một lần chỉnh duy nhất là nội dung của hàng loat các đối tượng được chọn đều thay đổi giống nhau.

Mình có gặp một ông KTS sử dụng R14 và ổng dùng lệnh này rất hay nhưng khi mình có ý muốn hỏi xin thì ổng nói là khi ổng viết chỉ sài được trên R14 thôi . Nên mình bâng khuân mãi mà không có được câu trả lời nay nhờ các Pro chỉ giáo giúp và nếu được có thể cho mình lisp của lệnh trên luôn xin cảm ơn nhiều.

Ông KTS này dám là ông KTS Duy lắm . Bạn load về tại Đây? nhé.

Lisp này có trên cadviet rồi nhưng mình lười tìm.

Tên lệnh: MAT

-Thao tác:

+Nhập lệnh MAT

+Chọn đồi tượng mẫu có thể là TEXT, MTEXT, DIM nều không chọn được đối tượng hoặc đối tượng chọn không thuộc 3 loại trên thì hỏi lại đến khi chọn được thì làm dấu bằng dấu + màu xanh lá.

+Hỏi chọn các đối tượng muốn thay đổi, bạn có thể chọn bằng cửa sổ lisp sẽ chỉ nhận các đối tượng là TEXT, MTEXT, DIM trong vùng chọn.

+Nhấn enter các đối tượng được chọn sẽ có nội dung giống y như đối tượng mẫu.

Nếu các bác thấy việc "con con" mà cũng lôi tới lisp ra dùng thì cũng đừng chửi tui tội nghiệp (dạo này tui hơi điên nên chửi là tui chửi lại ráng chịu)

[phamthanhbinh 3.146]

@phamthanhbinh: để xác định các điểm đó có thể dùng bất cứ các nào (trừ việc pick từng điểm #__#) , mình đang nghĩ thuật toán có thể là:

 

+1: lần lược quét từng cạnh của đa giác, dùng 1 hàm nào đó tìm những điểm thuộc cạnh đó

+2: quét tất cà các điểm có trong hình, dùng 1 hàm nào đó để kiểm tra xem điểm đó có thuộc boundary hay không => xác định đ' thuộc cạnh nào

....

Mình sẽ cố gắng học thêm về lisp nữa

Bạn hdt4151,

Như vậy có nghĩa là các điểm đó phải là các điểm đã có sẵn trên bản vẽ và có rất nhiều điểm như vậy. Vậy các điểm đó là do khi bạn vẽ bạn tạo ra hay là do người khác tạo sẵn rồi hử bạn??? Các điểm đó có dặc tính gì không??? Bạn hãy post một bản vẽ có chứa các điểm như vậy nhé.

Bạn nhớ rằng lisp sẽ không tự xác định được các điểm nếu như bạn không cho biết các đặc tình của điểm. Tỷ như hai đường thẳng cắt nhau thì sẽ có một điểm chung nhưng lisp sẽ không biết được điểm đó có phải là điểm bạn cần hay không......

Với các điểm có sẵn tức là các đối tượng được người dùng tạo ra với các mả dxf 0 là POINT thì có thể lọc được xong thứ tự của nó sẽ là một vấn đề bạn ạ.

Đối với những điểm chưa được xác định trước mà bây giờ bạn mới muốn đặt nó vào bản vẽ thì bạn cũng phải cho biết cách xác định các điểm đó bạn ạ, Tỷ như đó là các giao điểm với các đường cong khác chẳng hạn....

Vậy bạn hãy suy nghĩ thấu đáo về những vấn đề trên rồi đặt ra bài toán tổng quát bạn nhé.

Chúc bạn vui.

[ketxu 2.984]

Híc híc,mấy hôm ốm quá,không theo dõi được diễn đàn,giờ đã qua mấy trang rồi :cheers: ..

Có vấn đề này,các bác giúp e với...E muốn giãn 2(hoặc nhiều) đường thẳng song song ra,hoặc co vào 1 khoảng nhất định so với đường gốc như hình dưới ạ.

Đầu vào :

Bước

-1 : quét chọn 3 đường (3 đường này song song)

-2 : chọn kcách giãn (âm hoặc dương) (trong hình minh họa là 1)

-3 : kích vào 1 điểm thuộc đường thẳng làm gốc,hoặc pick chọn đường thẳng gốc (ở đây là đường màu xanh)

==> kết quả : 2 đường màu vàng sẽ dịch ra (nếu dương) hoặc sát vào (âm) theo phương vuông góc với đường thẳng gốc.

Mở rộng ra nhiều đường thì tốt ạ

[hdt4151 1]

Bạn hdt4151,

Như vậy có nghĩa là các điểm đó phải là các điểm đã có sẵn trên bản vẽ và có rất nhiều điểm như vậy. Vậy các điểm đó là do khi bạn vẽ bạn tạo ra hay là do người khác tạo sẵn rồi hử bạn??? Các điểm đó có dặc tính gì không??? Bạn hãy post một bản vẽ có chứa các điểm như vậy nhé.

Bạn nhớ rằng lisp sẽ không tự xác định được các điểm nếu như bạn không cho biết các đặc tình của điểm. Tỷ như hai đường thẳng cắt nhau thì sẽ có một điểm chung nhưng lisp sẽ không biết được điểm đó có phải là điểm bạn cần hay không......

Với các điểm có sẵn tức là các đối tượng được người dùng tạo ra với các mả dxf 0 là POINT thì có thể lọc được xong thứ tự của nó sẽ là một vấn đề bạn ạ.

Đối với những điểm chưa được xác định trước mà bây giờ bạn mới muốn đặt nó vào bản vẽ thì bạn cũng phải cho biết cách xác định các điểm đó bạn ạ, Tỷ như đó là các giao điểm với các đường cong khác chẳng hạn....

Vậy bạn hãy suy nghĩ thấu đáo về những vấn đề trên rồi đặt ra bài toán tổng quát bạn nhé.

Chúc bạn vui.

 

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

[phamngoctukts 714]

Híc híc,mấy hôm ốm quá,không theo dõi được diễn đàn,giờ đã qua mấy trang rồi :cheers: ..

Có vấn đề này,các bác giúp e với...E muốn giãn 2(hoặc nhiều) đường thẳng song song ra,hoặc co vào 1 khoảng nhất định so với đường gốc như hình dưới ạ.

Đầu vào :

Bước

-1 : quét chọn 3 đường (3 đường này song song)

-2 : chọn kcách giãn (âm hoặc dương) (trong hình minh họa là 1)

-3 : kích vào 1 điểm thuộc đường thẳng làm gốc,hoặc pick chọn đường thẳng gốc (ở đây là đường màu xanh)

==> kết quả : 2 đường màu vàng sẽ dịch ra (nếu dương) hoặc sát vào (âm) theo phương vuông góc với đường thẳng gốc.

Mở rộng ra nhiều đường thì tốt ạ

Cái này bạn xoá béng 2 đường 2 bên đi xong dùng lisp vetuong của mình là nhanh nhất.

[phamthanhbinh 3.146]

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

Chào bạn hd4151,

Bạn dùng thử cái này coi sao.

Điều kiện là các điểm phải được tạo trước và có độ lệch so với đường biên không quá lớn.

;; 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")))
        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)
           (progn 
                 (setq dplst (append dplst (list (list pa p0))))
           )
       )
       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
(setq dplst (vl-sort dplst '(lambda (x1 x2) ((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) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Trong lisp này mình sử dụng các parameter của các điểm trên boundary để sắp xếp lại chúng theo thứ tự tạo thành boundary và dùng hàm (vlax-curve-getclosestpointto ......) để xác đ5nh điểm thuộc boundary bạn ạ.

Hãy so sánh cái lisp này với cái lisp cũ của mình để tìm sự khác biệt và tương đồng giữa chúng.

Hy vọng lisp thỏa mãn các yêu cầu bạn đã đặt ra....

[phamthanhbinh 3.146]

Híc híc,mấy hôm ốm quá,không theo dõi được diễn đàn,giờ đã qua mấy trang rồi :cheers: ..

Có vấn đề này,các bác giúp e với...E muốn giãn 2(hoặc nhiều) đường thẳng song song ra,hoặc co vào 1 khoảng nhất định so với đường gốc như hình dưới ạ.

Đầu vào :

Bước

-1 : quét chọn 3 đường (3 đường này song song)

-2 : chọn kcách giãn (âm hoặc dương) (trong hình minh họa là 1)

-3 : kích vào 1 điểm thuộc đường thẳng làm gốc,hoặc pick chọn đường thẳng gốc (ở đây là đường màu xanh)

==> kết quả : 2 đường màu vàng sẽ dịch ra (nếu dương) hoặc sát vào (âm) theo phương vuông góc với đường thẳng gốc.

Mở rộng ra nhiều đường thì tốt ạ

Vì sao bạn không dùng lệnh scale nhỉ????? Muốn co giãn tùy thích và Muốn bao nhiêu đường cũng vẫn ngon bạn ạ.

[hdt4151 1]

@phamthanhbinh: bạn xem lại lisp xem, mình load chạy bị lỗi " error: bad argument type: lselsetp nil" sau khi chọn gốc toạ độ.

[phamngoctukts 714]

@phamthanhbinh: bạn xem lại lisp xem, mình load chạy bị lỗi " error: bad argument type: lselsetp nil" sau khi chọn gốc toạ độ.

Sai đoạn này (setq ssp (ssget "CP" ptlst (list (cons 0 "POINT"))) vì trong bản vẽ bạn uplen không có "point" nào cả

[ketxu 2.984]

Cái này bạn xoá béng 2 đường 2 bên đi xong dùng lisp vetuong của mình là nhanh nhất.

Vẫn vấn đề về tỉ lệ bác ạ ^^.Hơn nữa,em vẽ móng chẳng hạn,vẽ tường xong lại ngồi trim chỗ giao với đài móng ạ..E đang vẽ dở dầm móng 300 rồi chẳng hạn,chủ đầu tư lại chẹp miệng thấy bé,bắt tăng lên 330.Nhà thì mấy chục cái dầm,thế là cứ ngồi of hết ra rồi lại z vào xóa cái bên trong đi :cheers:(

 

 

Vì sao bạn không dùng lệnh scale nhỉ????? Muốn co giãn tùy thích và Muốn bao nhiêu đường cũng vẫn ngon bạn ạ.

Dùng lệnh scale thì 2 đầu nó không còn giữ được nữa bác ơi.E lại ngồi trim :|

 

PS : Liệu có cách nào giãn 2 đường biên ra thì các đường thẳng vuông góc với các đường này tại đỉnh line tự stretch ra theo (như associate sim ấy ạ) k các bác nhỉ.Làm thế để không phải trim lại chỗ giao với đài móng nữa(1 công việc khá boring :cheers: )

[phamthanhbinh 3.146]

@phamthanhbinh: bạn xem lại lisp xem, mình load chạy bị lỗi " error: bad argument type: lselsetp nil" sau khi chọn gốc toạ độ.

Chào hdt4151,

Bạn đọc kỹ điều kiện dùng lisp của mình. Do chỉ để bạn kiểm tra xem có đúng yêu cầu của bạn hay không nên mình chưa đặt hàm điều kiện cho nó, Nếu bạn thấy đạt yêu cầu mình mới làm tiếp cho hoàn chỉnh đỡ mất công bạn ạ. Bởi vì bạn có nhiều ý tưởng phát sinh quá nên rất khó biết thế nào là đúng ý bạn .....

Bạn chỉ muốn người khác phải hiểu bạn còn bạn không hề quan tâm tới người khác nghĩ gì sao?????

[phamthanhbinh 3.146]

Dùng lệnh scale thì 2 đầu nó không còn giữ được nữa bác ơi.E lại ngồi trim :|

 

PS : Liệu có cách nào giãn 2 đường biên ra thì các đường thẳng vuông góc với các đường này tại đỉnh line tự stretch ra theo (như associate sim ấy ạ) k các bác nhỉ.Làm thế để không phải trim lại chỗ giao với đài móng nữa(1 công việc khá boring :cheers: )

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é.

[phamngoctukts 714]

Chào bạn hd4151,

Bạn dùng thử cái này coi sao.

Điều kiện là các điểm phải được tạo trước và có độ lệch so với đường biên không quá lớn.

;; 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")))
        n (sslength ssp)
        j 0
) ;;;;;;;;;;;; End setq
(while (< j n)
       (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)
           (progn 
                 (setq dplst (append dplst (list (list pa p0))))
           )
       )
       (setq j (1+ j))
) ;;;;;;;;;;;; End while j
(setq dplst (vl-sort dplst '(lambda (x1 x2) (< (car x1) (car x2)))))
(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) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

Trong lisp này mình sử dụng các parameter của các điểm trên boundary để sắp xếp lại chúng theo thứ tự tạo thành boundary và dùng hàm (vlax-curve-getclosestpointto ......) để xác đ5nh điểm thuộc boundary bạn ạ.

Hãy so sánh cái lisp này với cái lisp cũ của mình để tìm sự khác biệt và tương đồng giữa chúng.

Hy vọng lisp thỏa mãn các yêu cầu bạn đã đặt ra....

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

;; free lisp from cadviet.com
(defun c:tdd ()
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
k 0
ptlst nil
ssl (ssget "x" '((0 . "line,lwpolyline")))
)
(setvar "osmode" 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
obj (vlax-ename->vla-object name))
(while (/= (vlax-curve-getPointAtParam obj i) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)        
ptlst (append (list p1) ptlst)
i (1+ i))
)
(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT")))
        n (sslength ssp)
        j 0
)
(while (< j n)
(setq p1 (cdr (assoc 10 (entget (ssname ssp j)))))
(setq dlst (append (list (strcat (rtos (car p1) 2 3) "\t" (rtos (cadr p1) 2 3))) dlst))
(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 "")
)
(command "erase" ssp "")
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

[phamvanthiet108 11]

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

[gia_bach 1.551]

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

PS : Liệu có cách nào giãn 2 đường biên ra thì các đường thẳng vuông góc với các đường này tại đỉnh line tự stretch ra theo (như associate sim ấ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

[phamngoctukts 714]

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

Cái này bạn chỉ cần dùng lệnh find và replace all dấu , bằng dấu . là được cần gì dùng đến lisp.