Đến nội dung


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

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


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

#2161 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 08 October 2010 - 11:17 PM

Mấy anh giúp e với, có cách nào mà vẽ tỉ lế/20 hay bất kì một tỉ lệ nào mà ko phải tính toán không.
Ví dụ: mở bản vẽ cad lên thì nhập 1000, dim theo tỉ lệ 1/100 thì nó sẽ là 1000.
Bây giờ e muốn nhập 1000 thì tự động cad hiều là 4000 (vì e muốn có bản vẽ ở tỉ lệ 1/20, nghĩa là nhập vào 1 giá trị, sau khi enter thì cad tự động nhân số mình nhập cho 4).
Có anh nào biết cách ko, giúp e với.

Mình cũng đang hi vọng có đại ca nào nghiên cứu hook hoặc reactor về vấn đề này đây ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#2162 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 04:37 AM

Thế này thì vượt khỏi khả năng của mình rồi. Nhường lại các bác khúc xương nay mình bó tay rồi.

Chào Bác Bình, Chào bạn hdt4151!!
Mình nói thì là nói vậy thôi chứ thực ra mình vẫn tiếp tục nghiên cứu tiếp yêu cầu của bạn.
Cuối cùng thì cũng có giải pháp cho bạn. Đúng với mọi trường hợp dùng line và pline thẳng.
Bác Bình thử xem code rất đơn giản mà mình không nghĩ ra sớm. Code này đang bị chậm phần repeat do chưa biết đặt điều kiện gì cho hợp lý.
Bạn hdt4151 và các bác test thử code rồi cho ý kiến.


(defun pro ()
(setq ss (ssget "x" '((0 . "line,lwpolyline"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq ss (ssget "x" '((0 . "*line"))))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
)

(defun c:tdd ()
(command "undo" "be")
(pro)
(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")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p)
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3)
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(if (/= (ssget "WP" ptlst) nil)
(progn
(command "erase" name "")
(setq id (1- id))
(repeat (+ i 2)
(setq dlst1 (cdr dlst1))
)
)
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

  • 3
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2163 VoHoan

VoHoan

    biết lệnh move

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

Đã gửi 09 October 2010 - 09:19 AM

Mình chẳng biết các bác làm gì trước đó, nhưng nhìn hình vẽ của bạn thì có thể làm như vậy :
- 1/ Tìm hàm cắt tất cả các line tại điểm giao
- 2/ dùng lệnh (setq n (entlast)) để nhớ đối tượng cuối vào n
- 3/ dùng lệnh region để tạo các đa giác
- 4/ Tìm tập hợp ss các đối tượng tạo ra sau n cho đến cuối
- 5/ Xóa tất cả trừ ss lại
- 6/ Xóa entlast

Từ ý tưởng của 'TRUNGNGAMY' mình dùng lisp "BreakObjects.lsp" (sưu tâm trên CadViet) đế thực hiện thao tác "1/..." sau đó
thực hiện thao tác "3/..." là cho ra được kêt quả như yêu cầu. Tuy nhiên làm theo cách này thì sẽ thừa ra 1 hình lớn nhất bao
các hình kín còn lại!
  • 0

#2164 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 09:26 AM

Từ ý tưởng của 'TRUNGNGAMY' mình dùng lisp "BreakObjects.lsp" (sưu tâm trên CadViet) đế thực hiện thao tác "1/..." sau đó
thực hiện thao tác "3/..." là cho ra được kêt quả như yêu cầu. Tuy nhiên làm theo cách này thì sẽ thừa ra 1 hình lớn nhất bao
các hình kín còn lại!

Cái này mình đã giải quyết triệt để ở lisp tdd trên bạn tham khảo nhé. Sau khi viết xong lisp đọc lại các comment thì mới biết có người nghĩ giống mình. hê hê.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2165 VoHoan

VoHoan

    biết lệnh move

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

Đã gửi 09 October 2010 - 09:35 AM

Cái này mình đã giải quyết triệt để ở lisp tdd trên bạn tham khảo nhé. Sau khi viết xong lisp đọc lại các comment thì mới biết có người nghĩ giống mình. hê hê.

Mình thử load lisp của bạn về nhưng khi chạy báo lội "error: bad argument type: 2D/3D point: nil" nên không biết được
ý tưởng bạn đã làm.
  • 0

#2166 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 09:39 AM

Mình thử load lisp của bạn về nhưng khi chạy báo lội "error: bad argument type: 2D/3D point: nil" nên không biết được
ý tưởng bạn đã làm.

mình dùng vẫn bình thường mà. trên bản vẽ không dùng pline cong hay spline.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2167 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 09 October 2010 - 10:02 AM

Mình thử load lisp của bạn về nhưng khi chạy báo lội "error: bad argument type: 2D/3D point: nil" nên không biết được
ý tưởng bạn đã làm.

Đúng là báo lỗi trên "error: bad argument type: 2D/3D point: nil"

Nếu muốn xóa cái region bao ngoài cùng thì phải duyệt qua từng Region, tìm region nào có diện tích lớn nhất và xóa nó đi
Ở dòng này : (setq ss (ssget "x" '((0 . "line,lwpolyline"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
lwpolyline không có mã DXF nào bằng 11 cả bạn ạ. Đó cũng chính là nguyên nhân gây nên lỗi "error: bad argument type: 2D/3D point: nil". Coi như bản vẽ bạn có PLINE thì xem như là không đúng rồi :cheers: . Vì thế nên Lisp không còn đúng với PLINE thẳng nữa
  • 0

#2168 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 09 October 2010 - 10:08 AM

@phamngoctukts: chào bạn, mình thực sự rất ấn tượng với kết quả lisp chạy, thanks bạn rất nhiều :cheers:

Lisp vẫn còn 1 lỗi nhỏ là khi tồn tại cạnh của 1 đa giác điểm nằm trên cạnh của 1 đa giác khác (2 cạnh không nhau) => lisp sẽ sinh ra 1 đa giác bao tất cả các đa giác lại (không thoã đk ban đầu là 1 đa giác không có đa giác khác nằm trong nó) => sẽ cho ra thừa 1 đa giác

File VD minh hoạ :
http://www.mediafire...v4vurleh577d6pr
Theo như file thì sẽ tìm được 5 đa giác nhưng lisp cho ra 6 đa giác (thêm 1 đa giác bao tất cả các đa giác lại)

Nếu những đường line gồm N nhóm nằm tách biệt nhau => sẽ tạo ra N đa giác thừa.

------
Ấy, mình post chậm quá, mọi người đã nói về lỗi trên hết rồi +_+
  • 0

#2169 KS.PhanThanhTu

KS.PhanThanhTu

    biết vẽ point

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

Đã gửi 09 October 2010 - 11:29 AM

Mấy anh giúp e với, có cách nào mà vẽ tỉ lế/20 hay bất kì một tỉ lệ nào mà ko phải tính toán không.
Ví dụ: mở bản vẽ cad lên thì nhập 1000, dim theo tỉ lệ 1/100 thì nó sẽ là 1000.
Bây giờ e muốn nhập 1000 thì tự động cad hiều là 4000 (vì e muốn có bản vẽ ở tỉ lệ 1/20, nghĩa là nhập vào 1 giá trị, sau khi enter thì cad tự động nhân số mình nhập cho 4).
Có anh nào biết cách ko, giúp e với.

Bạn dùng layout là ok thôi :cheers:
  • 0
KS Phan Thanh Tú.Email: Vansulich@yahoo.com

#2170 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

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

Đã gửi 09 October 2010 - 11:53 AM

Từ ý tưởng của 'TRUNGNGAMY' mình dùng lisp "BreakObjects.lsp" (sưu tâm trên CadViet) đế thực hiện thao tác "1/..." sau đó
thực hiện thao tác "3/..." là cho ra được kêt quả như yêu cầu. Tuy nhiên làm theo cách này thì sẽ thừa ra 1 hình lớn nhất bao
các hình kín còn lại!

Hình bao lớn nhất đc tạo ra cuối cùng. Bạn hãy xóa đi cái entlast. Đối với trường hợp có nhiều nhóm độc lập, bạn hãy chọn từng nhóm để thực hiện
  • 0

#2171 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 11:54 AM

Đúng là báo lỗi trên "error: bad argument type: 2D/3D point: nil"
Theo file của bạn hdt thì bạn phải bẽ gãy các đối tượng tại các giao điểm của nó
Nếu muốn xóa cái region bao ngoài cùng thì phải duyệt qua từng Region, tìm region nào có diện tích lớn nhất và xóa nó đi
Ở dòng này : (setq ss (ssget "x" '((0 . "line,lwpolyline"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
lwpolyline không có mã DXF nào bằng 11 cả bạn ạ. Đó cũng chính là nguyên nhân gây nên lỗi "error: bad argument type: 2D/3D point: nil". Coi như bản vẽ bạn có PLINE thì xem như là không đúng rồi :cheers: . Vì thế nên Lisp không còn đúng với PLINE thẳng nữa

Thank Bác! Đúng là nhầm chỗ này. Thực ra em cung không để ý lúc test dùng toàn line nên không báo lỗi.
BS: Cái này theo em nghĩ chỉ cần explode các pline ra là được đỡ phải phân thành nhiều trường hợp.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2172 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 12:06 PM

@phamngoctukts: chào bạn, mình thực sự rất ấn tượng với kết quả lisp chạy, thanks bạn rất nhiều :cheers:

Lisp vẫn còn 1 lỗi nhỏ là khi tồn tại cạnh của 1 đa giác điểm nằm trên cạnh của 1 đa giác khác (2 cạnh không nhau) => lisp sẽ sinh ra 1 đa giác bao tất cả các đa giác lại (không thoã đk ban đầu là 1 đa giác không có đa giác khác nằm trong nó) => sẽ cho ra thừa 1 đa giác

File VD minh hoạ :
http://www.mediafire...v4vurleh577d6pr
Theo như file thì sẽ tìm được 5 đa giác nhưng lisp cho ra 6 đa giác (thêm 1 đa giác bao tất cả các đa giác lại)

Nếu những đường line gồm N nhóm nằm tách biệt nhau => sẽ tạo ra N đa giác thừa.

------
Ấy, mình post chậm quá, mọi người đã nói về lỗi trên hết rồi +_+

Có lẽ do đêm qua mình thức khuya quá đầu óc mụ mẫm nên không đưa ra hết các trường hợp được. Lại tiếp tục nghiên cứu tiếp.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2173 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 09 October 2010 - 03:44 PM

Bạn dùng layout là ok thôi :cheers:

Em cũng biết là vậy, nhưng layout bất tiện lắm, nhất là vẽ kiến trúc xong, mấy anh kết cấu còn phải up lại đễ vẽ hệ kết cấu.
nếu làm dc thì không dùng layout.
không gian model thì e nghĩ là tuyệt hơn nhiều.
Em nghĩ có cách nào đó khắc phục chứ. Vì e thấy trong cad có mấy chỗ cho nhập 1:1, 1:10, 1:20, 1:50, 1:100.......
e nghĩ là có biện pháp mà e mò hoài không ra.hihi.....
  • 0

#2174 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 09 October 2010 - 10:05 PM

[quote name='phamngoctukts' date='Oct 9 2010, 12:06' post='111643']
Có lẽ do đêm qua mình thức khuya quá đầu óc mụ mẫm nên không đưa ra hết các trường hợp được. Lại tiếp tục nghiên cứu tiếp.
Chào bác Phamngoctukts,
Mình có một ý tưởng, chưa biết là trúng hay trật, song do đang kẹt quá chưa thực hiện được. Nếu có thể bác thử làm xem nhé.
1/- Lấy tập hợp các điểm cắt nhau của các line và pline. loại bỏ các điểm trùng nhau.
2/- Lặp qua tất cả các điểm này như sau:
Tại mỗi điểm lặp n bước xc định boundary với n điểm phân bố đều quanh điểm đó bằng lệnh polar.
Lấy tập hợp các boundary được tạo thành, lọc các boundary trùng nhau.
Lấy đỉnh của các boundary òn lại sau khi lọc
3/- áp dụng lisp tdd.

Như vậy sẽ tránh được việc bị trùng boundary bởi lệnh region như bác đã biết. Tuy nhiên có một nhược điểm là líp sẽ bỏ qua các boundary có kích thước nhỏ hơn bán kính polar và góc phân bố là 360độ/n. Do vậy người dùng cần lựa chọn n và bán kính polar cho phù hợp với yêu cầu và làm giảm thời gian xử lý của lisp.

Hy vọng rằng cách này sẽ thỏa mãn được yêu cầu đặt ra của bạn hdt4151.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2175 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 09 October 2010 - 10:27 PM

Chào bác Phamngoctukts,
Mình có một ý tưởng, chưa biết là trúng hay trật, song do đang kẹt quá chưa thực hiện được. Nếu có thể bác thử làm xem nhé.
1/- Lấy tập hợp các điểm cắt nhau của các line và pline. loại bỏ các điểm trùng nhau.
2/- Lặp qua tất cả các điểm này như sau:
Tại mỗi điểm lặp n bước xc định boundary với n điểm phân bố đều quanh điểm đó bằng lệnh polar.
Lấy tập hợp các boundary được tạo thành, lọc các boundary trùng nhau.
Lấy đỉnh của các boundary òn lại sau khi lọc
3/- áp dụng lisp tdd.

Như vậy sẽ tránh được việc bị trùng boundary bởi lệnh region như bác đã biết. Tuy nhiên có một nhược điểm là líp sẽ bỏ qua các boundary có kích thước nhỏ hơn bán kính polar và góc phân bố là 360độ/n. Do vậy người dùng cần lựa chọn n và bán kính polar cho phù hợp với yêu cầu và làm giảm thời gian xử lý của lisp.

Hy vọng rằng cách này sẽ thỏa mãn được yêu cầu đặt ra của bạn hdt4151.

Chào bác Bình Bác có thể nói rõ hơn ý này được không?
Tại mỗi điểm lặp n bước xc định boundary với n điểm phân bố đều quanh điểm đó bằng lệnh polar.
...
Cảm ơn bác
  • 0

#2176 tomboy

tomboy

    biết vẽ polygon

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

Đã gửi 10 October 2010 - 01:22 AM

Chào Bác Bình, Chào bạn hdt4151!!
Mình nói thì là nói vậy thôi chứ thực ra mình vẫn tiếp tục nghiên cứu tiếp yêu cầu của bạn.
Cuối cùng thì cũng có giải pháp cho bạn. Đúng với mọi trường hợp dùng line và pline thẳng.
Bác Bình thử xem code rất đơn giản mà mình không nghĩ ra sớm. Code này đang bị chậm phần repeat do chưa biết đặt điều kiện gì cho hợp lý.
Bạn hdt4151 và các bác test thử code rồi cho ý kiến.



(defun pro ()
(setq ss (ssget "x" '((0 . "line,lwpolyline"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq ss (ssget "x" '((0 . "*line"))))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
)

(defun c:tdd ()
(command "undo" "be")
(pro)
(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")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p)
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3)
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(if (/= (ssget "WP" ptlst) nil)
(progn
(command "erase" name "")
(setq id (1- id))
(repeat (+ i 2)
(setq dlst1 (cdr dlst1))
)
)
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(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 phamngoctukts mình đã nghiên cứu kỹ lip của bạn rồi, bạn viết ngắn gọn rất hay, nhưng mình thấy bạn còn thiếu 1 điều kiện nữa đấy, thực ra bạn sử dụng Command Region cho một tập hợp chọn thì nó sẽ sinh ra rất nhiều đa giác đấy, nếu như vậy bạn phải thêm 1 đoạn mã để lọc các đa giác thừa ra nữa, để lọc được đa giác thừa thì phức tạp đây và nó sẽ làm cho chương trình của bạn kồng kềnh hơn nhiều. Cái thứ hai nữa theo mình nghĩ bạn không nên để chế độ bắt đối tượng một cách tự động được mà phải làm thủ công thì hay hơn vì nhiều khi bản vẽ lớn sẽ làm cho chương trình của ban chạy chậm, mình chạy thử của bạn rồi, bản vẽ của mình có tổng cộng 451 line thế mà mình không kiên nhẫn đợi nó chạy xong được. Cái thứ 3 là bạn nên thêm 1 dòng thông báo cho người dùng biết chương trình đã chạy xong và kết quả được lưu ở đâu. Bạn tiếp tục hoàn chỉnh đi nhé.Chúc bạn vui.
  • 0

#2177 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 October 2010 - 08:34 AM

Hình bao lớn nhất đc tạo ra cuối cùng. Bạn hãy xóa đi cái entlast. Đối với trường hợp có nhiều nhóm độc lập, bạn hãy chọn từng nhóm để thực hiện

Không hẳn như thế đâu bác TRUNGNGAMY ạ. Khi tạo Region thì hình bao lớn nhất chưa hẳn đã là được tạo ra cuối cùng. Đây là bằng chứng : http://www.mediafire...96o4dc5y6oyhqfv :cheers:
Bác hãy thử tạo các Region đối với bản vẽ này và sẽ thấy được điều đó.

Nếu muốn xóa cái region bao ngoài cùng thì phải duyệt qua từng Region, tìm region nào có diện tích lớn nhất và xóa nó đi


  • 0

#2178 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 11 October 2010 - 08:38 AM

@phamngoctukts: chào bạn, mình thực sự rất ấn tượng với kết quả lisp chạy, thanks bạn rất nhiều :cheers:

Lisp vẫn còn 1 lỗi nhỏ là khi tồn tại cạnh của 1 đa giác điểm nằm trên cạnh của 1 đa giác khác (2 cạnh không nhau) => lisp sẽ sinh ra 1 đa giác bao tất cả các đa giác lại (không thoã đk ban đầu là 1 đa giác không có đa giác khác nằm trong nó) => sẽ cho ra thừa 1 đa giác

File VD minh hoạ :
http://www.mediafire...v4vurleh577d6pr
Theo như file thì sẽ tìm được 5 đa giác nhưng lisp cho ra 6 đa giác (thêm 1 đa giác bao tất cả các đa giác lại)

Nếu những đường line gồm N nhóm nằm tách biệt nhau => sẽ tạo ra N đa giác thừa.

------
Ấy, mình post chậm quá, mọi người đã nói về lỗi trên hết rồi +_+

Chào bạn hdt4151. Mình đã fix loại bỏ được cái đa giác lớn nhất rồi. với các nhóm đa giác nằm tách biệt thì mình đưa ra phương án lựa chọn bằng tay (chưa nghĩ ra cách giải quyết vấn đề này).

Chào bạn phamngoctukts mình đã nghiên cứu kỹ lip của bạn rồi, bạn viết ngắn gọn rất hay, nhưng mình thấy bạn còn thiếu 1 điều kiện nữa đấy, thực ra bạn sử dụng Command Region cho một tập hợp chọn thì nó sẽ sinh ra rất nhiều đa giác đấy, nếu như vậy bạn phải thêm 1 đoạn mã để lọc các đa giác thừa ra nữa, để lọc được đa giác thừa thì phức tạp đây và nó sẽ làm cho chương trình của bạn kồng kềnh hơn nhiều. Cái thứ hai nữa theo mình nghĩ bạn không nên để chế độ bắt đối tượng một cách tự động được mà phải làm thủ công thì hay hơn vì nhiều khi bản vẽ lớn sẽ làm cho chương trình của ban chạy chậm, mình chạy thử của bạn rồi, bản vẽ của mình có tổng cộng 451 line thế mà mình không kiên nhẫn đợi nó chạy xong được. Cái thứ 3 là bạn nên thêm 1 dòng thông báo cho người dùng biết chương trình đã chạy xong và kết quả được lưu ở đâu. Bạn tiếp tục hoàn chỉnh đi nhé.Chúc bạn vui.

Các bạn thử cái này xem sao nhé.

;; free lisp from cadviet.com

(defun pro ()
(setq ss (ssget "x" '((0 . "lwpolyline"))))
(if (/= ss nil)
(repeat (sslength ss) (command "explode" ss)))
(setq ss (ssget '((0 . "line"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq ss (ssget "x" '((0 . "*line"))))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while (< i (sslength list_pl))
(setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(setq delname boname))
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl))
)


(defun c:tdd ()
(command "undo" "be")
(pro)
(locbo)
(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")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p)
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3)
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

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

#2179 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 11 October 2010 - 10:20 AM

Chào bạn hdt4151. Mình đã fix loại bỏ được cái đa giác lớn nhất rồi. với các nhóm đa giác nằm tách biệt thì mình đưa ra phương án lựa chọn bằng tay (chưa nghĩ ra cách giải quyết vấn đề này).

Các bạn thử cái này xem sao nhé.
(defun pro ()
...........
(setq ss (ssget '((0 . "line"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
..............
(setq ss (ssget "x" '((0 . "*line"))))
)

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

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.
(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)
Góp ý nhỏ : bạn chú ý hơn đến các hàm VisualLisp vì VisualLisp hỗ trợ tính giao điểm tốt hơn cũng như việc lấy diện tích của đối tuợng rất là đơn giản (như bắt cua trong hang vậy). :cheers:

............
Mình có một ý tưởng, chưa biết là trúng hay trật, song do đang kẹt quá chưa thực hiện được. Nếu có thể bác thử làm xem nhé.
1/- Lấy tập hợp các điểm cắt nhau của các line và pline. loại bỏ các điểm trùng nhau.
2/- Lặp qua tất cả các điểm này như sau:
Tại mỗi điểm lặp n bước xc định boundary với n điểm phân bố đều quanh điểm đó bằng lệnh polar.
Lấy tập hợp các boundary được tạo thành, lọc các boundary trùng nhau.
Lấy đỉnh của các boundary òn lại sau khi lọc
3/- áp dụng lisp tdd.

Như vậy sẽ tránh được việc bị trùng boundary bởi lệnh region như bác đã biết. Tuy nhiên có một nhược điểm là líp sẽ bỏ qua các boundary có kích thước nhỏ hơn bán kính polar và góc phân bố là 360độ/n. Do vậy người dùng cần lựa chọn n và bán kính polar cho phù hợp với yêu cầu và làm giảm thời gian xử lý của lisp.
..................

Chào bác Bình
Cá nhân tôi thấy ý tuởng này khá hay.
Chỉ xin bổ sung phần lọc boundary như sau :
- gọi tập SSboundary là tập các boundary đuợc tao ra.
- nếu điểm Pt không nằm trong các boundary này (SSboundary) -> tạo boundary tại điểm Pt.
(hàm này bạn Tuệ có viết rồi.)
Để khắc phục nhược điểm mà bác nêu, chúng ta gán bán kính polar bằng khoảng cách nhỏ nhất giữa các điểm trong tập điểm tìm đuợc ở buớc 1.
Về góc phân bố : vì thông thuờng thửa đất ít khi có góc nhỏ hơn 15 độ, nên tạm chọn góc = 15 độ
(nếu yêu cầu chính xác hơn thì chọn góc nhỏ xuống)

Gửi các bác hàm tìm tất cả giao điểm của tập chọn (*LINE,ARC,CIRCLE,ELLIPSE)
(defun c:test1 (/ ss)
(vl-load-com)
(if (setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE") )) )
(foreach pt (getSS_Inter ss)
(entmake (list (cons '0 "POINT")(cons '10 pt))) ))
(princ))

(defun giao (ob1 ob2 / inter_lst iplist)
(if (not (vl-catch-all-error-p
(setq iplist (vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone) ))))))
(progn
(while (setq inter_lst (cons (list (car iplist) (cadr iplist) (caddr iplist)) inter_lst)
iplist (cdddr iplist)))
(reverse inter_lst) ) ))

(defun getSS_Inter (ss / e giao_lst i lst obj tmp_lst)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq lst (cons (vlax-ename->vla-object e) lst)) )
(repeat (1- (vl-list-length lst))
(setq obj (car lst))
(foreach ob1 (setq lst (vl-remove obj lst ))
(if (setq tmp_lst (giao ob1 obj))
(foreach pt tmp_lst
(if (not (vl-position pt giao_lst))
(setq giao_lst (cons pt giao_lst))))) ) )
giao_lst )

  • 2

#2180 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 11 October 2010 - 10:37 AM

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.
(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)
Góp ý nhỏ : bạn chú ý hơn đến các hàm VisualLisp vì VisualLisp hỗ trợ tính giao điểm tốt hơn cũng như việc lấy diện tích của đối tuợng rất là đơn giản (như bắt cua trong hang vậy). :cheers:

Hàm tìm giao điểm này bác bình đã áp dụng trong code của bác ấy rồi. Vì dùng để vẽ các thửa đất người vẽ ít khi sử dụng các đường cong để vẽ (em đang nghiên cứu phần ngắt đoạn của đường cong nhưng có lẽ là không cần thiết) mà toàn dùng pline thẳng là chính. Trong TH này chưa chắc dùng visualLisp nhanh hơn vì vẫn phải đặt các biến p1, p2, p3, p4 để làm điều kiện sét các điểm trùng nhau.
Vì mục đích của lisp này là xuất toạ độ các đỉnh nên sau khi xuất toạ độ đỉnh chỉ cần undo lại như ban đầu là ok. (sử dụng undo mark và back)
Thank bác đã góp ý!!!
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!