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

#2241 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 15 October 2010 - 02:45 PM

Bác test tiếp giúp em nhé. không biết còn lỗi gì không. Cách sắp xếp thư tự như vậy đã được chưa?


(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(setq ss (ssget "x" '((0 . "line"))))
(setq lss (append lss (list ss)))
(taobo lss)
)

(defun taobo ( lss / )
(setq k 0 list_point (ssadd))
(while (< k (length lss))
(setq ss (nth k lss))
(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
)
(command "point" (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
(setq poi (entlast)
list_point (ssadd poi list_point))
(command "change" list_point "" "p" "la" "point_template" "")
(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))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(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))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(command "erase" 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))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0)
(while (< i (sslength list_pl))
(setq namel (ssname list_pl i))
(setq ob (vlax-ename->vla-object namel)
c 0 dsp nil)
(while (/= (vlax-curve-getPointAtParam ob c) nil)
(setq pt (vlax-curve-getPointAtParam ob c))
(setq dsp (append (list pt) dsp))
(setq c (1+ c))
)
(setq ssdk (ssget "Wp" dsp (list (cons 0 "point") (cons 8 "point_template"))))
(if (/= ssdk nil)
(progn
(command "erase" namel "")
(setq ss_pl (ssdel namel list_pl))
)
)
(setq i (1+ i))
)
(command "erase" list_point "")
(sapxep ss_pl)
)
(defun c:tdd ()
(inittdd)
(command "undo" "be")
(command "zoom" "e")
(setq tbl (tblsearch "layer" "point_template"))
(if (= tbl nil) (command "-layer" "n" "point_template" ""))
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
id 1
ptlst nil
dlst1 nil
list_pl nil
)
(ndt)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength ssmoi))
(setq name (ssname ssmoi p)
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1)
)
(setq ptam (centroid name))
(if (eq (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
(command "text" "j" "m" ptam "" "" (rtos id 2 0))
(command "text" "j" "m" ptam "" (rtos id 2 0))
)
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(alert (strcat "file da duoc luu tai: " file))
(startapp "notepad" file)
)

(defun inittdd ()
(setq
tdd_old_er *error*
*error* tdderror
)
)

(defun tdderror (errmsg)
(loitdd)
)
(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

(defun centroid (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re)
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

(defun sapxep ( sscu /)
(setq i 0 l_i nil l_ps nil)
(while (< i (sslength sscu))
(setq ename (ssname sscu i))
(setq ps (centroid ename))
(setq l_ps (append (list (cadr ps)) l_ps)
l_i (append (list i) l_i)
)
(setq i (1+ i))
)
(setq ssmoi (ssadd))
(while (/= l_i nil)
(setq nho (apply 'max l_ps))
(setq kt (nth (vl-position nho l_ps) l_i))
(setq ssmoi (ssadd (ssname sscu kt) ssmoi))
(setq l_ps (vl-remove nho l_ps))
(setq l_i (vl-remove kt l_i))
)
)

BS: code vẫn bị hơi lỗi đã edit lại rồi.

Trước tiên, Tue_NV cảm ơn bạn Tú đã bỏ khá nhiều thời gian để viết Lisp này. Tuy nhiên, vẫn còn tồn tại 1 số khuyết điểm lớn như sau :
1. Việc sắp xếp vẫn lộn xộn, không có trật tự gì cả. Test trên nhiều nhóm thửa, mỗi nhóm thửa là 1 đa giác thửa mẹ có nhiều thửa con.
2. Ý Tue_NV nói là chọn 1 loạt đối tượng để xử lý, chứ không phải là tự động chọn tất cả đa giác thửa để xử lý. Chọn 1 loạt đối tượng là chọn nhiều nhóm thửa mẹ khác nhau, trong đó có nhiều thửa con. Lisp chọn luôn tất cả thửa để xử lý luôn như vậy là chưa phù hợp, trong khi User chỉ muốn chọn 1, 2 hay 3... nhóm thửa mẹ(có 1 hay nhiều thửa con để xử lý mà thôi)
3. Nhược điểm lớn nhất là : Khi chạy Lisp xong, các Pline, hay Line hay chính đối tượng gốc bị xóa mất rồi. Điều này hoàn toàn không nên. Nên trả lại những gì mà User đã có ban đầu.
Bạn làm Tue_NV liên tưởng tới bài hát này và hãy thư giãn với ca khúc này nhé :
Trả lại em yêu
Nếu không "trả lại", "em yêu" "bắt đền" đó :cheers:
  • 1

#2242 huong259

huong259

    biết lệnh refedit

  • Members
  • PipPipPipPipPipPipPip
  • 596 Bài viết
Điểm đánh giá: 350 (khá)

Đã gửi 15 October 2010 - 03:12 PM

Bạn làm Tue_NV liên tưởng tới bài hát này và hãy thư giãn với ca khúc này nhé :
Trả lại em yêu
Nếu không "trả lại", "em yêu" "bắt đền" đó :cheers:

Anh Tuệ ơi!
Xin anh đừng :
” Trả lại em yêu khung trời mùa hạ”
Và em cũng xin anh:
“Đừng ra đi về miền cát nóng”
Và xin anh:
đừng giận em anh nhé!
Em không dám
bắt đền anh đâu
đừng nghĩ oan em thế!
  • 1

#2243 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 03:47 PM

Trước tiên, Tue_NV cảm ơn bạn Tú đã bỏ khá nhiều thời gian để viết Lisp này. Tuy nhiên, vẫn còn tồn tại 1 số khuyết điểm lớn như sau :
1. Việc sắp xếp vẫn lộn xộn, không có trật tự gì cả. Test trên nhiều nhóm thửa, mỗi nhóm thửa là 1 đa giác thửa mẹ có nhiều thửa con.
2. Ý Tue_NV nói là chọn 1 loạt đối tượng để xử lý, chứ không phải là tự động chọn tất cả đa giác thửa để xử lý. Chọn 1 loạt đối tượng là chọn nhiều nhóm thửa mẹ khác nhau, trong đó có nhiều thửa con. Lisp chọn luôn tất cả thửa để xử lý luôn như vậy là chưa phù hợp, trong khi User chỉ muốn chọn 1, 2 hay 3... nhóm thửa mẹ(có 1 hay nhiều thửa con để xử lý mà thôi)
3. Nhược điểm lớn nhất là : Khi chạy Lisp xong, các Pline, hay Line hay chính đối tượng gốc bị xóa mất rồi. Điều này hoàn toàn không nên. Nên trả lại những gì mà User đã có ban đầu.
Bạn làm Tue_NV liên tưởng tới bài hát này và hãy thư giãn với ca khúc này nhé :
Trả lại em yêu
Nếu không "trả lại", "em yêu" "bắt đền" đó :cheers:

Chào bác Tue_VN! Cám ơn bác đã test và cho ý kiến. Vì không phải là dân chắc địa nên em không lường trước được hết các tình huống được bán thông cảm nhé.
1. cái này em cũng đang đau đầu vì thuật toán sắp xếp đối tượng. Bác nào rành về vấn đề này thì giúp em với.
2. Cái này thì dễ chỉ cần bỏ "x" trong ssget là được.
3. Cái này cũng không thành vấn đề. Em đã giải quyết được rồi.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2244 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 03:49 PM

Trước tiên, Tue_NV cảm ơn bạn Tú đã bỏ khá nhiều thời gian để viết Lisp này. Tuy nhiên, vẫn còn tồn tại 1 số khuyết điểm lớn như sau :
1. Việc sắp xếp vẫn lộn xộn, không có trật tự gì cả. Test trên nhiều nhóm thửa, mỗi nhóm thửa là 1 đa giác thửa mẹ có nhiều thửa con.
2. Ý Tue_NV nói là chọn 1 loạt đối tượng để xử lý, chứ không phải là tự động chọn tất cả đa giác thửa để xử lý. Chọn 1 loạt đối tượng là chọn nhiều nhóm thửa mẹ khác nhau, trong đó có nhiều thửa con. Lisp chọn luôn tất cả thửa để xử lý luôn như vậy là chưa phù hợp, trong khi User chỉ muốn chọn 1, 2 hay 3... nhóm thửa mẹ(có 1 hay nhiều thửa con để xử lý mà thôi)
3. Nhược điểm lớn nhất là : Khi chạy Lisp xong, các Pline, hay Line hay chính đối tượng gốc bị xóa mất rồi. Điều này hoàn toàn không nên. Nên trả lại những gì mà User đã có ban đầu.
Bạn làm Tue_NV liên tưởng tới bài hát này và hãy thư giãn với ca khúc này nhé :
Trả lại em yêu
Nếu không "trả lại", "em yêu" "bắt đền" đó :cheers:

Hề hề hề,
Bác Tue_NV ơi,
Thực ra cái việc sắp xếp này ấy là do mấy anh cu địa chính làm, mình thấy các bản vẽ của mấy anh cu đó cũng lộn xộn ghê gớm, chả có quy luật quy liệc gì cả. Hình như với các anh cu ấy thì cái quy luật lại là tùy hứng bác ạ.
Vì lẽ đó cho nên người dùng phải đưa ra được cái gọi là quy luật ấy thì lisper mới viết được, còn bảo là tự định ra quy luật thì có khi mấy anh cu ấy lại bảo là chơi trèo bác ạ.
Hề hề hề....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2245 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 04:00 PM

Chào bác Tue_VN! Cám ơn bác đã test và cho ý kiến. Vì không phải là dân chắc địa nên em không lường trước được hết các tình huống được bán thông cảm nhé.
1. cái này em cũng đang đau đầu vì thuật toán sắp xếp đối tượng. Bác nào rành về vấn đề này thì giúp em với.
2. Cái này thì dễ chỉ cần bỏ "x" trong ssget là được.
3. Cái này cũng không thành vấn đề. Em đã giải quyết được rồi.

Hề hề hề,
cái vụ sắp xếp ấy khó mà cũng chả khó lắm bác ạ, vấn đề là phải hiểu cái quy luạt họ cần mà thôi. Tỷ như từ trên xuống, từ dưới lên, từ bé đến to vv.....
Hề hề hề, bác cứ chọn cái nào khoái mà chơi vì đó là cái quy luật của bác , có ai bắt bò đâu mà bác lo....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2246 w1nDream

w1nDream

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 293 Bài viết
Điểm đánh giá: 73 (tàm tạm)

Đã gửi 15 October 2010 - 04:16 PM

Chào mọi người.Em muốn nhờ mọi người giúp đỡ em viết 1 con Lisp thực hiện 1 tổ hợp lệnh để làm các công việc như hình biểu diễn trong file dưới đây:

http://www.cadviet.c.../km15__km16.dwg

Em làm bên giao thông nên rất hay phải thực hiện các công việc trên với số lượng lớn nhưng lại toàn phải làm thủ công.Mong các Pác júp đỡ!
:cheers:


Các Pác ơi!
Không ai giúp em à.Em đang rất cần.Mong tin................!

:cheers:
  • 0
__Tâm tựa lưu thủY__
Vi nhân nan

#2247 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 04:20 PM

Hề hề hề,
cái vụ sắp xếp ấy khó mà cũng chả khó lắm bác ạ, vấn đề là phải hiểu cái quy luạt họ cần mà thôi. Tỷ như từ trên xuống, từ dưới lên, từ bé đến to vv.....
Hề hề hề, bác cứ chọn cái nào khoái mà chơi vì đó là cái quy luật của bác , có ai bắt bò đâu mà bác lo....

Chào bác Bình.
Quả thật việc sắp xếp này đối với em là rất khó vì chưa làm trường hợp này bao giờ. Cái khó ở đây là sắp xếp lại trật tự của selection set. em đã làm riêng trong phần (defun sapxep () ....). Các bác nghiên cứu xem có thể giúp được cho em không. Em muốn sắp xếp đơn giản là từ trên xuống dưới từ trái qua phải thôi bác ạ.
code mới đây đã fix ý 2 và 3 của Bác Tue_VN.

;; free lisp from cadviet.com
(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(setq ss (ssget '((0 . "line"))))
(setq lss (append lss (list ss)))
(command "zoom" "e")
(taobo lss)
)

(defun taobo ( lss / )
(setq k 0 list_point (ssadd))
(while (< k (length lss))
(setq ss (nth k lss))
(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
)
(command "point" (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
(setq poi (entlast)
list_point (ssadd poi list_point))
(command "change" list_point "" "p" "la" "point_template" "")
(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))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(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))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(command "erase" 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))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0)
(while (< i (sslength list_pl))
(setq namel (ssname list_pl i))
(setq ob (vlax-ename->vla-object namel)
c 0 dsp nil)
(while (/= (vlax-curve-getPointAtParam ob c) nil)
(setq pt (vlax-curve-getPointAtParam ob c))
(setq dsp (append (list pt) dsp))
(setq c (1+ c))
)
(setq ssdk (ssget "Wp" dsp (list (cons 0 "point") (cons 8 "point_template"))))
(if (/= ssdk nil)
(progn
(command "erase" namel "")
(setq ss_pl (ssdel namel list_pl))
)
)
(setq i (1+ i))
)
(command "erase" list_point "")
(sapxep ss_pl)
)


(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq tbl (tblsearch "layer" "point_template"))
(if (= tbl nil) (command "-layer" "n" "point_template" ""))
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
id 1
ptlst nil
dlst1 nil
list_pl nil
list_chu (ssadd)
)
(ndt)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength ssmoi))
(setq name (ssname ssmoi p))
(command "area" "o" name)
(setq i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0) " dien tich: " (rtos (getvar "area") 2 3))) dlst1)
)
(setq ptam (centroid name))
(setq tx (getvar "textstyle"))
(if (eq (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
(command "text" "j" "m" ptam "" "" (rtos id 2 0))
(command "text" "j" "m" ptam "" (rtos id 2 0))
)
(setq list_chu (ssadd (entlast) list_chu))
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(command "_.copyclip" list_chu "")
(command "block" "chu" "0,0" list_chu "")
(command "insert" "chu" "0,0" "" "" "")
(setq pchu (nth 0 (acet-ent-geomextents (entlast))))
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(command "_.pasteclip" pchu)
(alert (strcat "file da duoc luu tai: " file))
(startapp "notepad" file)
)

(defun inittdd ()
(setq
tdd_old_er *error*
*error* tdderror
)
)

(defun tdderror (errmsg)
(loitdd)
)


(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

(defun centroid (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re)
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

(defun sapxep ( sscu /)
(setq i 0 l_i nil l_ps nil)
(while (< i (sslength sscu))
(setq ename (ssname sscu i))
(setq ps (centroid ename))
(setq l_ps (append (list (- (cadr ps) (car ps))) l_ps)
l_i (append (list i) l_i)
)
(setq i (1+ i))
)
(setq ssmoi (ssadd))
(setq m 0)
(while (/= l_i nil)
(setq nho (apply 'max l_ps))
(setq kt (nth (vl-position nho l_ps) l_i))
(setq ssmoi (ssadd (ssname sscu kt) ssmoi))
(setq l_ps (vl-remove nho l_ps))
(setq l_i (vl-remove kt l_i))
(setq m (1+ m))
)
)

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

#2248 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 04:23 PM

Hề hề hề,
Bác Tue_NV ơi,
Thực ra cái việc sắp xếp này ấy là do mấy anh cu địa chính làm, mình thấy các bản vẽ của mấy anh cu đó cũng lộn xộn ghê gớm, chả có quy luật quy liệc gì cả. Hình như với các anh cu ấy thì cái quy luật lại là tùy hứng bác ạ.
Vì lẽ đó cho nên người dùng phải đưa ra được cái gọi là quy luật ấy thì lisper mới viết được, còn bảo là tự định ra quy luật thì có khi mấy anh cu ấy lại bảo là chơi trèo bác ạ.
Hề hề hề....

Tóm lại là cái anh nào đó Post yêu cầu lên rồi chẳng thấy đâu cả ?
Chỉ còn các Lisper trao đổi với nhau thôi.
Đôi khi tôi nghĩ có nên theo đuổi vấn đề này nữa không? Nhưng ....
"Lỡ yêu rồi ..." : chua cay mặn ngọt ... gì gì nữa cũng "trăm dâu đổ đầu tằm".

tôi có ý này : Bài toán này chỉ cần tập trung vào giải quyết Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc), vấn đề trích xuất tọa độ khi đã có đuờng bao là chuyện nhỏ (các bác cũng viết nhiều rồi).

Về Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc) thì có 2 cách :
1. Ph/án của phamngoctukts
- break tất cả các đối tuợng tại điểm giao
- tạo Region với các đối tuợng vừa break
- convert các region thành Pline (xóa Pline bao trùm)

2. Ph/án của bác Bình
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này : tạo Boundary
- xóa các Boundary trùng nhau

Vài dòng, chúc các bác cuối tuần "vui vẻ với nguời yêu".

Lisp cải tiến từ lisp xpatp của bác Bình.
Nội dung chính :
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này :

+ nếu tạo đuợc Boundary : duyệt qua các đỉnh của Boundary xóa các điểm này trong tập giao điểm ớ buớc 1
Kết quả : chỉ tạo đuợc khoảng 90% Boundary nhưng tốc độ chấp nhận đuợc.
(defun c:xpatp (/ boun boundFlag dis_min i j nEnt plst pt sec ss time tmp vl ov rempt)  
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,ARC"))))
(progn
(command "undo" "be")
(setq time (getvar "millisecs"))
(setq nEnt (entlast)
vl '("BLIPMODE" "CMDECHO" "OSMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '( 0 0 0))
(setq j 0
plst (getSS_Inter ss)
plst (vl-sort plst '(lambda (x y)(or (< (cadr x)(cadr y))
(and (< (car x)(car y))
(= (cadr x)(cadr y))) ) ))
dis_min (* 0.8(getDistan_min plst)))
(while plst
(setq i 0
boundFlag t
pt (car plst)
plst (cdr plst))
(while (and boundFlag (< i 24))
(setq tmp (polar pt (+ 3.2 (* 0.25 i)) dis_min))
(if (and
(not (ssget tmp));Point is directly on an object.
(MakeBPoly tmp) )
(progn
(setq boun (entlast) k (1+ k)
boundFlag nil)
(foreach bounPt (poly-pts boun)
(if (setq rempt (member1 bounPt plst))
(setq plst (vl-remove rempt plst)) ))))
(setq i (1+ i)) ) )
(setq sec (/ (- (getvar "MILLISECS") time) 1000.0) )
(while (setq nEnt (entnext nEnt))
(setq j (1+ j)) )
(if (> j 0)
(princ (strcat "\nTao duoc " (itoa j) " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
(princ (strcat "\nSorry! Khong tao duoc duong bao!")))
(mapcar 'setvar vl ov)
(command "undo" "e"))
(princ (strcat "\nKhong chon duoc doi tuong!")))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeBPoly (pt / ele)
(setq ele (entlast))
(if(vl-cmdf "_BPOLY" "_A" "_I" "_N" "" "" pt "");(vl-cmdf "boundary" pt "")
(if (not(equal (entlast) ele)) t )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(and
(not (equal ob1 obj))
(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 )

(defun poly-pts (pl / n p l)
(vl-load-com)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (vlax-curve-IsClosed pl) (setq n (1+ n)))
(while (setq p (vlax-curve-getPointAtParam pl (setq n (1- n))))
(setq l (cons p l)) ))

(defun member1 (a b / res)
(if b
(foreach x b
(if (equal x a 0.1)
(setq res x) ) ) )
res)

(defun getDistan_min (lst / dis pt1 tmp)
(setq dis (distance (car lst) (cadr lst)))
(repeat (1- (vl-list-length lst))
(setq pt1 (car lst))
(foreach pt2 (setq lst (vl-remove pt1 lst ))
(if (< (setq tmp (distance pt1 pt2)) dis)
(setq dis tmp) ) ) )
dis )

  • 0

#2249 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 04:32 PM

Tóm lại là cái anh nào đó Post yêu cầu lên rồi chẳng thấy đâu cả ?
Chỉ còn các Lisper trao đổi với nhau thôi.
Đôi khi tôi nghĩ có nên theo đuổi vấn đề này nữa không? Nhưng ....
"Lỡ yêu rồi ..." : chua cay mặn ngọt ... gì gì nữa cũng "trăm dâu đổ đầu tằm".

tôi có ý này : Bài toán này chỉ cần tập trung vào giải quyết Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc), vấn đề trích xuất tọa độ khi đã có đuờng bao là chuyện nhỏ (các bác cũng viết nhiều rồi).

Về Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc) thì có 2 cách :
1. Ph/án của phamngoctukts
- break tất cả các đối tuợng tại điểm giao
- tạo Region với các đối tuợng vừa break
- convert các region thành Pline (xóa Pline bao trùm)

2. Ph/án của bác Bình
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này : tạo Boundary
- xóa các Boundary trùng nhau

Vài dòng, chúc các bác cuối tuần "vui vẻ với nguời yêu".

Lisp cải tiến từ lisp xpatp của bác Bình.
Nội dung chính :
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này :

+ nếu tạo đuợc Boundary : duyệt qua các đỉnh của Boundary xóa các điểm này trong tập giao điểm ớ buớc 1
Kết quả : chỉ tạo đuợc khoảng 90% Boundary nhưng tốc độ chấp nhận đuợc.

(defun c:xpatp (/ boun boundFlag dis_min i j nEnt plst pt sec ss time tmp vl ov rempt)  
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,ARC"))))
(progn
(command "undo" "be")
(setq time (getvar "millisecs"))
(setq nEnt (entlast)
vl '("BLIPMODE" "CMDECHO" "OSMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '( 0 0 0))
(setq j 0
plst (getSS_Inter ss)
plst (vl-sort plst '(lambda (x y)(or (< (cadr x)(cadr y))
(and (< (car x)(car y))
(= (cadr x)(cadr y))) ) ))
dis_min (* 0.8(getDistan_min plst)))
(while plst
(setq i 0
boundFlag t
pt (car plst)
plst (cdr plst))
(while (and boundFlag (< i 24))
(setq tmp (polar pt (+ 3.2 (* 0.25 i)) dis_min))
(if (and
(not (ssget tmp));Point is directly on an object.
(MakeBPoly tmp) )
(progn
(setq boun (entlast) k (1+ k)
boundFlag nil)
(foreach bounPt (poly-pts boun)
(if (setq rempt (member1 bounPt plst))
(setq plst (vl-remove rempt plst)) ))))
(setq i (1+ i)) ) )
(setq sec (/ (- (getvar "MILLISECS") time) 1000.0) )
(while (setq nEnt (entnext nEnt))
(setq j (1+ j)) )
(if (> j 0)
(princ (strcat "\nTao duoc " (itoa j) " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
(princ (strcat "\nSorry! Khong tao duoc duong bao!")))
(mapcar 'setvar vl ov)
(command "undo" "e"))
(princ (strcat "\nKhong chon duoc doi tuong!")))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeBPoly (pt / ele)
(setq ele (entlast))
(if(vl-cmdf "_BPOLY" "_A" "_I" "_N" "" "" pt "");(vl-cmdf "boundary" pt "")
(if (not(equal (entlast) ele)) t )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(and
(not (equal ob1 obj))
(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 )

(defun poly-pts (pl / n p l)
(vl-load-com)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (vlax-curve-IsClosed pl) (setq n (1+ n)))
(while (setq p (vlax-curve-getPointAtParam pl (setq n (1- n))))
(setq l (cons p l)) ))

(defun member1 (a b / res)
(if b
(foreach x b
(if (equal x a 0.1)
(setq res x) ) ) )
res)

(defun getDistan_min (lst / dis pt1 tmp)
(setq dis (distance (car lst) (cadr lst)))
(repeat (1- (vl-list-length lst))
(setq pt1 (car lst))
(foreach pt2 (setq lst (vl-remove pt1 lst ))
(if (< (setq tmp (distance pt1 pt2)) dis)
(setq dis tmp) ) ) )
dis )

Tại sao lại được có 90% vậy bác nhỉ. Em chưa đọc code mới test thử thì thấy tốc độ cưc nhanh nhưng lại thiếu mất mấy cáo boundary.
  • 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!

#2250 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 05:51 PM

Các Pác ơi!
Không ai giúp em à.Em đang rất cần.Mong tin................!

:cheers:

Chào bạn W1ndream,
Mình đã đọc yêu cầu của bạn song có một số điểm chưa rõ muốn hỏi lại bạn như sau:
1/- Cái hình bạn post lên tìm hoài chả thấy chỗ nào giống như cái yêu cầu cả, tức là chả có chỗ nào thấy cái text -0.00 màu vàng và text 0.00 màu xanh cả.
2/- Có phải bạn muốn chỉnh tất cả các text màu vàng mà bị chồng lên nhau thành các text cách đều nhau không??? Như vậy thì vị trí của nó có thể sẽ không còn tương thích với vị trí thực trên bản vẽ. Điều này có ảnh hưởng gì đến công việc của bạn hay không???
3/- Bạn chỉ hiệu chỉnh các text có width factor là 0.8 thôi hay tất cả các text bất kể width factor của nó.
4/- Có thể thay thế việc dãn các text ra bằng việc xóa bớt các text chồng lên nhau để đảm bảo giữ đúng vị trí của các text tương ứng với vị trí thực trên bản vẽ hay không???

Nhìn chung yêu cầu của bạn là có thể thực hiện được, tuy nhiên bạn cần gửi một bản vẽ thể hiện hai trạng thái trước và sau khi chạy lisp với đúng tình trạng thực của nó chứ không phải là copy cái ảnh ví dụ ra. (do trên bản vẽ bạn gửi mình tìm không thấy cái đoạn mẫu đó nên không biết phải thử lisp ở đâu trên bản vẽ của bạn) Bạn hãy đánh dấu cái vị trí cần chỉnh sửa của bạn trên bản vẽ. Nhớ là bản vẽ chứ không phải file ảnh vì khi viết lisp sẽ cần sử dụng tới các thuộc tính của các đối tượng trên bả vẽ của bạn, mà file ảnh thì không thể có các thuộc tính này.

Chờ sự hồi âm của bạn.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2251 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 06:04 PM

Tóm lại là cái anh nào đó Post yêu cầu lên rồi chẳng thấy đâu cả ?
Chỉ còn các Lisper trao đổi với nhau thôi.
Đôi khi tôi nghĩ có nên theo đuổi vấn đề này nữa không? Nhưng ....
"Lỡ yêu rồi ..." : chua cay mặn ngọt ... gì gì nữa cũng "trăm dâu đổ đầu tằm".

tôi có ý này : Bài toán này chỉ cần tập trung vào giải quyết Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc), vấn đề trích xuất tọa độ khi đã có đuờng bao là chuyện nhỏ (các bác cũng viết nhiều rồi).

Về Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc) thì có 2 cách :
1. Ph/án của phamngoctukts
- break tất cả các đối tuợng tại điểm giao
- tạo Region với các đối tuợng vừa break
- convert các region thành Pline (xóa Pline bao trùm)

2. Ph/án của bác Bình
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này : tạo Boundary
- xóa các Boundary trùng nhau

Vài dòng, chúc các bác cuối tuần "vui vẻ với nguời yêu".

Lisp cải tiến từ lisp xpatp của bác Bình.
Nội dung chính :
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này :

+ nếu tạo đuợc Boundary : duyệt qua các đỉnh của Boundary xóa các điểm này trong tập giao điểm ớ buớc 1
Kết quả : chỉ tạo đuợc khoảng 90% Boundary nhưng tốc độ chấp nhận đuợc.

(defun c:xpatp (/ boun boundFlag dis_min i j nEnt plst pt sec ss time tmp vl ov rempt)  
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,ARC"))))
(progn
(command "undo" "be")
(setq time (getvar "millisecs"))
(setq nEnt (entlast)
vl '("BLIPMODE" "CMDECHO" "OSMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '( 0 0 0))
(setq j 0
plst (getSS_Inter ss)
plst (vl-sort plst '(lambda (x y)(or (< (cadr x)(cadr y))
(and (< (car x)(car y))
(= (cadr x)(cadr y))) ) ))
dis_min (* 0.8(getDistan_min plst)))
(while plst
(setq i 0
boundFlag t
pt (car plst)
plst (cdr plst))
(while (and boundFlag (< i 24))
(setq tmp (polar pt (+ 3.2 (* 0.25 i)) dis_min))
(if (and
(not (ssget tmp));Point is directly on an object.
(MakeBPoly tmp) )
(progn
(setq boun (entlast) k (1+ k)
boundFlag nil)
(foreach bounPt (poly-pts boun)
(if (setq rempt (member1 bounPt plst))
(setq plst (vl-remove rempt plst)) ))))
(setq i (1+ i)) ) )
(setq sec (/ (- (getvar "MILLISECS") time) 1000.0) )
(while (setq nEnt (entnext nEnt))
(setq j (1+ j)) )
(if (> j 0)
(princ (strcat "\nTao duoc " (itoa j) " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
(princ (strcat "\nSorry! Khong tao duoc duong bao!")))
(mapcar 'setvar vl ov)
(command "undo" "e"))
(princ (strcat "\nKhong chon duoc doi tuong!")))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeBPoly (pt / ele)
(setq ele (entlast))
(if(vl-cmdf "_BPOLY" "_A" "_I" "_N" "" "" pt "");(vl-cmdf "boundary" pt "")
(if (not(equal (entlast) ele)) t )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(and
(not (equal ob1 obj))
(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 )

(defun poly-pts (pl / n p l)
(vl-load-com)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (vlax-curve-IsClosed pl) (setq n (1+ n)))
(while (setq p (vlax-curve-getPointAtParam pl (setq n (1- n))))
(setq l (cons p l)) ))

(defun member1 (a b / res)
(if b
(foreach x b
(if (equal x a 0.1)
(setq res x) ) ) )
res)

(defun getDistan_min (lst / dis pt1 tmp)
(setq dis (distance (car lst) (cadr lst)))
(repeat (1- (vl-list-length lst))
(setq pt1 (car lst))
(foreach pt2 (setq lst (vl-remove pt1 lst ))
(if (< (setq tmp (distance pt1 pt2)) dis)
(setq dis tmp) ) ) )
dis )




Tại sao lại được có 90% vậy bác nhỉ. Em chưa đọc code mới test thử thì thấy tốc độ cưc nhanh nhưng lại thiếu mất mấy cáo boundary.

Hề hề hề,
Có nhẽ bác lại bị dính ở chỗ các boundary có chứa arc rồi bác ạ. Khi boundary có chứa arc thì bác sẽ phải tạo region rồi lại explode nó mới được bác ạ. Vấn đề này bác Tue_NV đã có đề cập và mình cũng chỉ mới phát hiện ra sau khi bác ấy nhắc nhở. Có nhẽ đây cũng chính là nhược điểm của cái phương án mình đưa ra bác ạ
Mình đang dò cái lisp của bác để mót lấy một vài kỹ thuật tạo và lọc boundary sao cho hiệu quả nhất. Có nhẽ nên check và loại ngay sau khi tạo boundary vì như vậy sẽ tiết kiệm được các bước lọc bác ạ.
Hề hề hề.....

Mặt khác trong quá trình thử lisp, mình phát hiện ra là nếu như cái boundary không được nhòm thấy đủ lớn thì việc pick điểm sẽ rất dễ bị bỏ qua mà chả thèm quan tâm đến nó. Đặc biệt là khi khoảng cách điểm pick với điểm đỉnh boundary khá nhỏ bác ạ.
Hề hề hề, cái anh cu boundary này cũng đỏng đảnh ra phết đấy.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2252 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 07:49 PM

Tóm lại là cái anh nào đó Post yêu cầu lên rồi chẳng thấy đâu cả ?
Chỉ còn các Lisper trao đổi với nhau thôi.
Đôi khi tôi nghĩ có nên theo đuổi vấn đề này nữa không? Nhưng ....
"Lỡ yêu rồi ..." : chua cay mặn ngọt ... gì gì nữa cũng "trăm dâu đổ đầu tằm".

tôi có ý này : Bài toán này chỉ cần tập trung vào giải quyết Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc), vấn đề trích xuất tọa độ khi đã có đuờng bao là chuyện nhỏ (các bác cũng viết nhiều rồi).

Về Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc) thì có 2 cách :
1. Ph/án của phamngoctukts
- break tất cả các đối tuợng tại điểm giao
- tạo Region với các đối tuợng vừa break
- convert các region thành Pline (xóa Pline bao trùm)

2. Ph/án của bác Bình
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này : tạo Boundary
- xóa các Boundary trùng nhau

Vài dòng, chúc các bác cuối tuần "vui vẻ với nguời yêu".

Lisp cải tiến từ lisp xpatp của bác Bình.
Nội dung chính :
- tìm giao điểm của tất cả các đối tuợng
- duyệt qua các giao điểm này :

+ nếu tạo đuợc Boundary : duyệt qua các đỉnh của Boundary xóa các điểm này trong tập giao điểm ớ buớc 1
Kết quả : chỉ tạo đuợc khoảng 90% Boundary nhưng tốc độ chấp nhận đuợc.

(defun c:xpatp (/ boun boundFlag dis_min i j nEnt plst pt sec ss time tmp vl ov rempt)  
(if (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,ARC"))))
(progn
(command "undo" "be")
(setq time (getvar "millisecs"))
(setq nEnt (entlast)
vl '("BLIPMODE" "CMDECHO" "OSMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '( 0 0 0))
(setq j 0
plst (getSS_Inter ss)
plst (vl-sort plst '(lambda (x y)(or (< (cadr x)(cadr y))
(and (< (car x)(car y))
(= (cadr x)(cadr y))) ) ))
dis_min (* 0.8(getDistan_min plst)))
(while plst
(setq i 0
boundFlag t
pt (car plst)
plst (cdr plst))
(while (and boundFlag (< i 24))
(setq tmp (polar pt (+ 3.2 (* 0.25 i)) dis_min))
(if (and
(not (ssget tmp));Point is directly on an object.
(MakeBPoly tmp) )
(progn
(setq boun (entlast) k (1+ k)
boundFlag nil)
(foreach bounPt (poly-pts boun)
(if (setq rempt (member1 bounPt plst))
(setq plst (vl-remove rempt plst)) ))))
(setq i (1+ i)) ) )
(setq sec (/ (- (getvar "MILLISECS") time) 1000.0) )
(while (setq nEnt (entnext nEnt))
(setq j (1+ j)) )
(if (> j 0)
(princ (strcat "\nTao duoc " (itoa j) " duong bao voi Th/gian = "(rtos sec 2 2) " s."))
(princ (strcat "\nSorry! Khong tao duoc duong bao!")))
(mapcar 'setvar vl ov)
(command "undo" "e"))
(princ (strcat "\nKhong chon duoc doi tuong!")))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeBPoly (pt / ele)
(setq ele (entlast))
(if(vl-cmdf "_BPOLY" "_A" "_I" "_N" "" "" pt "");(vl-cmdf "boundary" pt "")
(if (not(equal (entlast) ele)) t )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(and
(not (equal ob1 obj))
(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 )

(defun poly-pts (pl / n p l)
(vl-load-com)
(setq n (fix (vlax-curve-getEndParam pl)))
(or (vlax-curve-IsClosed pl) (setq n (1+ n)))
(while (setq p (vlax-curve-getPointAtParam pl (setq n (1- n))))
(setq l (cons p l)) ))

(defun member1 (a b / res)
(if b
(foreach x b
(if (equal x a 0.1)
(setq res x) ) ) )
res)

(defun getDistan_min (lst / dis pt1 tmp)
(setq dis (distance (car lst) (cadr lst)))
(repeat (1- (vl-list-length lst))
(setq pt1 (car lst))
(foreach pt2 (setq lst (vl-remove pt1 lst ))
(if (< (setq tmp (distance pt1 pt2)) dis)
(setq dis tmp) ) ) )
dis )

Chào bác Giabach,
Sau khi ngâm cứu cái lisp của bác hơn một tiếng đồng hồ, mình thấy có một vài điểm muốn hỏi lại bác như sau:
1/- Ở bước duyệt qua các điểm giao cắt và tạo boundary (code màu đỏ dưới đây),
(while plst
(setq i 0
boundFlag t
pt (car plst)
plst (cdr plst))
(while (and boundFlag (< i 24))
(setq tmp (polar pt (+ 3.2 (* 0.25 i)) dis_min))
(if (and
(not (ssget tmp));Point is directly on an object.
(MakeBPoly tmp) )
(progn
(setq boun (entlast) k (1+ k)
boundFlag nil)
(foreach bounPt (poly-pts boun)
(if (setq rempt (member1 bounPt plst))
(setq plst (vl-remove rempt plst)) ))))
(setq i (1+ i)) ) )

theo lisp thì bác sẽ chỉ lặp cho tới khi có được boundary đầu tiên , khi đó biến boundflag sẽ nhận giá trị nil và lisp sẽ dừng lại không tiếp tục xét cái điểm đang xét nữa và chuyển sang điểm khác. Phải vậy không ạ???
Nếu vậy có thể sẽ gây nên việc thiếu boundary do rất có khả năng tại các điểm tiếp theo lisp cũng sẽ dừng tại chính cái boundary này bác ạ.
2/- Cái biến k của bác có tác dụng gì không ạ????
3/- Theo lý thuyết thì sẽ có 24 điểm tmp vì bác đặt biến i chạy từ 0 tới 23, nhưng khi bác polar với hàm (polar pt (+ 3.2 (* 0.25 i)) dis_min) thì có chắc chắn các điểm tmp này phân bố đều đủ một vòng quanh pt hay không ??? Các góc phân bố sẽ là 3.2, 3.45, 3.7, 3.95, 4.2, 4.45, 4.7, 4.95, 5.2, 5.45, 5.7, 5.95, 6.2, 6.45,.........., 8.95 (radian)
Do đó đây cũng có thể là nguyên nhân dẫn tới bị sót boundary bác ạ.

Rất mong bác giải đáp sớm để cái sự mót của mình được hanh thông bác nhé.
Cám ơn bác trước.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2253 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 15 October 2010 - 09:30 PM

UNDO được rồi nhưng khi UNDO nó mất truy bắt điểm.Mình đã thử làm như cách các bác chỉ trên diễn đàn nhưng không được.Mong các bác giúp đỡ.Chân thành cảm ơn trước.

Không bác nào giúp được e sao?
  • 0

#2254 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 15 October 2010 - 09:33 PM

Bài toán mình đặt ra cho đến bây ra h thực ra đã được giải quyết (đối với công việc + phần mềm của mình), tức là gồm các bước:
+ Chọn toạ độ ban đầu
+ Chọn từng nhóm đối tượng (đối với công việc của mình chỉ cần 1 nhóm thôi)
+ Break giao điểm giữa các line, tạo đa giác (region)
+ Xuất ra toạ độ của các đa giác.

Bạn Tú xem như đã giải quyết xong bài toán trên :cheers:

Những phát sinh khác chưa giải quyết triệt để (ứng dụng cho bên địa chính, làm về thửa đất ...) :

+ Chọn nhiều nhóm đối tượng => chỉ chọn 1 lần => Lisp sẽ tự tách ra thành từng nhóm riêng (thay vì chọn xong mỗi nhóm rồi nhấn Enter) như ý của bạn Tue_VN
+ Xuất Text ra ở mỗi đa giác => xuất ra tại trọng tâm . Với mỗi đa giác tìm được 1 trọng tâm => tạo 1 biến nào đó lưu 3 giá trị x y và S (số thứ tự của đa giác), sau khi undo trở lại trạng thái ban đầu => ghi text vào vị trí x y với giá trị là S.
- Nên thêm 1 dòng lệnh nhập chiều cao Text : sẽ tiện lợi cho 2 việc :
1- Chữ không lớn quá và chồng lên nhau.
2- Kiểm tra, VD chọn text hight = 3.59 => cả bản vẽ chỉ có 1 loại text có chiều cao như vậy, VD cần tìm thửa thứ 102 ta chỉ việc chọn quick select text = "102" và high = 3.59 , không sợ bị trùng 1 text nào đó cũng có giá trị "102" trong bản vẽ.
+ Ngoài break giao điểm của Line ra còn tính thêm Polyline, Arc ..

Lisp hiện h đang bị lỗi phần cuối cùng sau khi ghi text chưa xoá region. (Lúc này chỉ cần "u" 1 lần là trở về như ban đầu => ghi lại giá trị text, đc k nhỉ ? )
  • 0

#2255 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 15 October 2010 - 09:47 PM

Bài toán mình đặt ra cho đến bây ra h thực ra đã được giải quyết (đối với công việc + phần mềm của mình), tức là gồm các bước:
+ Chọn toạ độ ban đầu
+ Chọn từng nhóm đối tượng (đối với công việc của mình chỉ cần 1 nhóm thôi)
+ Break giao điểm giữa các line, tạo đa giác (region)
+ Xuất ra toạ độ của các đa giác.

Bạn Tú xem như đã giải quyết xong bài toán trên :cheers:

Những phát sinh khác chưa giải quyết triệt để (ứng dụng cho bên địa chính, làm về thửa đất ...) :

+ Chọn nhiều nhóm đối tượng => chỉ chọn 1 lần => Lisp sẽ tự tách ra thành từng nhóm riêng (thay vì chọn xong mỗi nhóm rồi nhấn Enter) như ý của bạn Tue_VN
+ Xuất Text ra ở mỗi đa giác => xuất ra tại trọng tâm . Với mỗi đa giác tìm được 1 trọng tâm => tạo 1 biến nào đó lưu 3 giá trị x y và S (số thứ tự của đa giác), sau khi undo trở lại trạng thái ban đầu => ghi text vào vị trí x y với giá trị là S.
- Nên thêm 1 dòng lệnh nhập chiều cao Text : sẽ tiện lợi cho 2 việc :
1- Chữ không lớn quá và chồng lên nhau.
2- Kiểm tra, VD chọn text hight = 3.59 => cả bản vẽ chỉ có 1 loại text có chiều cao như vậy, VD cần tìm thửa thứ 102 ta chỉ việc chọn quick select text = "102" và high = 3.59 , không sợ bị trùng 1 text nào đó cũng có giá trị "102" trong bản vẽ.
+ Ngoài break giao điểm của Line ra còn tính thêm Polyline, Arc ..

Lisp hiện h đang bị lỗi phần cuối cùng sau khi ghi text chưa xoá region. (Lúc này chỉ cần "u" 1 lần là trở về như ban đầu => ghi lại giá trị text, đc k nhỉ ? )

Bạn thử lisp cuối cùng của mình đi hầu như đã giải quyết hết các vấn đề. Vấn đề cònd lại chủ yếu là sắp xếp thứ tự các hình sao cho dễ tìm thôi.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2256 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 15 October 2010 - 10:36 PM

Hề hề hề,
cái vụ sắp xếp ấy khó mà cũng chả khó lắm bác ạ, vấn đề là phải hiểu cái quy luạt họ cần mà thôi. Tỷ như từ trên xuống, từ dưới lên, từ bé đến to vv.....
Hề hề hề, bác cứ chọn cái nào khoái mà chơi vì đó là cái quy luật của bác , có ai bắt bò đâu mà bác lo....
.....................
Hề hề hề,
Bác Tue_NV ơi,
Thực ra cái việc sắp xếp này ấy là do mấy anh cu địa chính làm, mình thấy các bản vẽ của mấy anh cu đó cũng lộn xộn ghê gớm, chả có quy luật quy liệc gì cả. Hình như với các anh cu ấy thì cái quy luật lại là tùy hứng bác ạ.
Vì lẽ đó cho nên người dùng phải đưa ra được cái gọi là quy luật ấy thì lisper mới viết được, còn bảo là tự định ra quy luật thì có khi mấy anh cu ấy lại bảo là chơi trèo bác ạ.
Hề hề hề....

Chào bác Bình
Em không phải là dân địa chính, em chỉ đam mê, yêu Lisp và tìm tòi các thuật toán của Lisp mà nó đem đến. Đôi lúc là niềm vui rất lớn, bác ạ. Còn bác bảo khó hay không thì bác vô bài toán này luôn là biết liền à :cheers:
Về vấn đề quy luật, thì nói thực ra do em đặt ra quy luật cho nó, chỉ là việc sắp xếp lại text cho dễ tìm kiếm, không được sắp xếp lộn xộn bác à. Em cũng đang ngâm cứu bài toán này bác ạ
Em ví dụ như : Có 3 đa giác mẹ. Mỗi đa giác mẹ lại có 6 đa giác con. Vậy thì đa giác mẹ thứ nhất được đánh số từ 1->6; đa giác mẹ thứ 2 được đánh số từ 7->12, đa giác mẹ thứ 3 đánh số từ 13->18. Khi chạy Lisp của bạn Tú thì việc sắp xếp bị lộn xộn, như hình dưới đây :
Hình đã gửi
Đó là em nói số lượng đa giác con không lớn, nếu lớn thì....
Các đa giác con trong đa giác mẹ lại được sắp xếp theo 1 trật tự nào đó như theo bạn Tú đề nghị là

Chào bác Bình.
Quả thật việc sắp xếp này đối với em là rất khó vì chưa làm trường hợp này bao giờ. Cái khó ở đây là sắp xếp lại trật tự của selection set. em đã làm riêng trong phần (defun sapxep () ....). Các bác nghiên cứu xem có thể giúp được cho em không. Em muốn sắp xếp đơn giản là từ trên xuống dưới từ trái qua phải thôi bác ạ.
.....

Cách làm vẫn thế -> Chọn 1 loạt đối tượng bác ạ.

.............
+ Ngoài break giao điểm của Line ra còn tính thêm Polyline, Arc ..
.........


Tóm lại là cái anh nào đó Post yêu cầu lên rồi chẳng thấy đâu cả ?
Chỉ còn các Lisper trao đổi với nhau thôi.
Đôi khi tôi nghĩ có nên theo đuổi vấn đề này nữa không? Nhưng ....
"Lỡ yêu rồi ..." : chua cay mặn ngọt ... gì gì nữa cũng "trăm dâu đổ đầu tằm".

tôi có ý này : Bài toán này chỉ cần tập trung vào giải quyết Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc), vấn đề trích xuất tọa độ khi đã có đuờng bao là chuyện nhỏ (các bác cũng viết nhiều rồi).

Về Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc) thì có 2 cách :
1. Ph/án của phamngoctukts
- break tất cả các đối tuợng tại điểm giao
- tạo Region với các đối tuợng vừa break
- convert các region thành Pline (xóa Pline bao trùm)
......................

Bài toán này thì Lisp của bạn Tú chưa làm được ạ
Cách tạo ra đuờng biên từ tập chọn (Line, Pline, Arc)
Chỉ đúng với Line, Pline thôi còn arc, Pline chứa Arc thì không còn đúng nữa

@w1nDream : Bạn hãy làm theo các ý của bác Bình ở bài viết số 2280 và upload file .dwg và nói rõ hơn nhé. Dường như 1 trong các ý bạn muốn là giãn đều Text ra 2 bên, tính từ điểm giữa thì phải??
  • 0

#2257 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 15 October 2010 - 11:27 PM

Bạn thử lisp cuối cùng của mình đi hầu như đã giải quyết hết các vấn đề. Vấn đề cònd lại chủ yếu là sắp xếp thứ tự các hình sao cho dễ tìm thôi.

Việc sắp xếp số thửa trong ngành địa chính là cực kỳ khó khăn các bạn ạ. Một số CT chuyên ngành vẫn kg sắp xếp đc vì lý do các thửa đất có hình thù rất đa dạng mà qui định thì rất khắc khe. Thường công đoạn đánh số phải làm bằng tay mới đạt. Qui định đại khái như vậy :
Thửa xuất phát từ đỉnh cao nhất hướng tây bắc và kết thúc ở thửa thấp nhất hướng đông nam. Đi từ trái qua phải rồi ngược lại và từ trên xuống dưới. Giữa hai thửa liền nhau có ít nhất một cạnh chung. Nếu có nhảy (qua thửa dài hay đường, rạch ...) thì khoảng nhảy là gần nhất. Một số CT tự động đánh số thửa theo kiểu vạch một đường nằm ngang, rồi đánh số các thửa giao với đg này từ trái qua phải hay ngược lại. Do đó, đôi lúc hai thửa liên nhau lại cách xa nhau. Mình có thể giải quyết hầu hết các yêu cầu của bản đồ địa chính nhưng cái giải thuật đánh số thửa này mình đã suy nghĩ và bỏ ngõ mưới mấy năm, cuối cùng thấy đánh tay vẫn đúng qui trình hơn và mình kiểm soát đc cái đg bao đi có đúng ranh thửa hay kg. Nếu bạn nào có ý tưởng giải quyết đc việc sắp xếp này thì quá hay.
Tuy nhiên, mình tìm đường bao thửa kg theo con đường của các bạn
  • 1

#2258 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 16 October 2010 - 12:30 AM

Bạn thử thay dòng :
(command ".boundary" "A" "B" "E" "I" "Y" "" p "")
bằng dòng :
(command "boundary" p "")


Được rùi anh ơi, em cám ơn anh nhiều.
  • 0

#2259 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 16 October 2010 - 12:41 PM

Mình copy dc cái líp này trên diễn đàn dùng để đánh số thứ tự bản vẽ. Tuy nhiên trong bản vẽ của mình số các bản từ 1đến 9 viết là 01, 02, 03....09. mà líp này lại chỉ ghi là 1, 2 ,3...9. thiếu số 0 ở đầu. bác nào giúp e thêm số 0 vào trước với.
Số bản vẽ từ 10 trở lên thi ngon rồi .THnk

(defun SS-enlst	(ss / c L)
(setq c -1)
(repeat (sslength ss)
(setq L (cons (ssname ss (setq c (1+ c))) L))
)
(reverse L)
)
(defun getatt (itm)
(vlax-safearray->list
(vlax-variant-value
(vla-GetAttributes itm)
)
)
)
(defun List->String (Lst Del)
(apply 'strcat
(cons
(car Lst)
(mapcar
'(lambda (l)
(strcat Del l)
)
(cdr Lst)
)
)
)
)
(defun dxf (id en) (cdr (assoc id (entget en))))
;;;-----------------------------------------------------------
(vl-load-com)
(defun c:chatt (/ blSet attLst lstbl bkname enblock)
(setq enblock (car (entsel "\nPick a blockref for get name")))
(while (null enblock)
(princ "\nIncorrect, Please pick again:")
(setq enblock (car (entsel "\nPick a blockref for get name")))
)
(setq lstTag (getatt (vlax-ename->vla-object enblock)))
(setq lstTag (mapcar 'vla-get-TagString lstTag))


;;;-----------------------------
(setq dcl_id (load_dialog "ATTI.dcl"))
(if (not (new_dialog "Atti" dcl_id))
(alert "\nKhong tim duoc file ATTI.dcl !")
)
;;;------- DCL Init ------------
(start_list "attdata" 3)
(mapcar 'add_list lstTag)
(end_list)
;;;------------------------------
(set_tile "attdata" "0")
(setq att_list "0"
order 1
star 1
delta 1
)
(action_tile "okay" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog)")
(action_tile "attdata" "(setq att_list $value)")
(action_tile "startstr" "(setq star (atoi $value))")
(action_tile "increment" "(setq delta (atoi $value))")
(action_tile "order1" "(setq order 1)")
(action_tile "order2" "(setq order 0)")
(setq execute_it (start_dialog))
(unload_dialog dcl_id)
;;;------- Main Program -----------
(if (= execute_it 1)
(progn
(setq bkname (cdr (assoc 8 (entget enblock))))
(princ "<<< Select blocks to change attributes >>>")
(if
(setq
blSet (ssget
(list (cons 0 "INSERT") (cons 8 bkname) (cons 66 1))
)
)
(progn
(cond ((= order 1)
(setq lstbl
(vl-sort (SS-enlst blSet)
'(lambda (x y)
(if (equal
(car (setq
x1 (trans (dxf 10 x) 0 1)
)
)
(car (setq
y1 (trans (dxf 10 y) 0 1)
)
)
)
(< (cadr x1) (cadr y1))
(< (car x1) (car y1))
)
)
)
)
)
((= order 0)
(setq lstbl
(vl-sort (SS-enlst blSet)
'(lambda (x y)
(if (equal
(car (setq
x1 (trans (dxf 10 x) 0 1)
)
)
(car (setq
y1 (trans (dxf 10 y) 0 1)
)
)
)
(> (cadr x1) (cadr y1))
(> (car x1) (car y1))
)
)
)
)
)
)
(setq blSet (mapcar 'vlax-ename->vla-object lstbl))
(setq TAG (nth (atoi att_list) lstTag))
(setq n star)
(foreach itm blSet
(setq attLst (getatt itm))
(foreach att attLst
(if (eq (strcase (vla-get-TagString att)) (strcase Tag))
(progn
(vla-put-textstring att (itoa n))
(setq n (+ n delta))
)
)
)
)
);;END progn
(princ ">>> Nothing blockref selected! <<<")
);end if
)
);end if
(princ "\nTHANK YOU FOR USE LISP CHANGE ATTRIBUTES. THIEP")
(princ)
)


đây là dcl ( ATTI.DCL)

Atti : dialog{
label ="STT CHO THUOC TINH";
: column{
: column{
: list_box{
label ="Chon Tag Name";
key ="attdata";
height = 15;
width = 30;
multiple_select = false;
fixed_width_font = false;
}
}
: column{
: edit_box{
key ="startstr";
label ="Chu bat dau:";
edit_width = 8;
value ="1";
}
: edit_box{
key ="increment";
label ="Tham so tang:";
edit_width = 8;
value ="1";
}
: column {
: boxed_radio_column {
label = "Cach sap xep :" ;
: radio_button {
label ="Trai -> Phai ; Duoi -> Tren";
key ="order1";
value ="1";
}
: radio_button {
label ="Phai -> Trai ; Tren -> Duoi";
key ="order2";
value ="0";
}
}
}
}
: boxed_row{
: button{key ="okay";
label ="Dong y";
is_default = true;
}
: button{key ="cancel";
label ="Thoat";
is_default = false;
is_cancel = true;
}
}
}
}

  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#2260 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 16 October 2010 - 01:32 PM

Chào bác Giabach,
Sau khi ngâm cứu cái lisp của bác hơn một tiếng đồng hồ, mình thấy có một vài điểm muốn hỏi lại bác như sau:
1/- Ở bước duyệt qua các điểm giao cắt và tạo boundary (code màu đỏ dưới đây),
........
theo lisp thì bác sẽ chỉ lặp cho tới khi có được boundary đầu tiên , khi đó biến boundflag sẽ nhận giá trị nil và lisp sẽ dừng lại không tiếp tục xét cái điểm đang xét nữa và chuyển sang điểm khác. Phải vậy không ạ???
Nếu vậy có thể sẽ gây nên việc thiếu boundary do rất có khả năng tại các điểm tiếp theo lisp cũng sẽ dừng tại chính cái boundary này bác ạ.
2/- Cái biến k của bác có tác dụng gì không ạ????
3/- Theo lý thuyết thì sẽ có 24 điểm tmp vì bác đặt biến i chạy từ 0 tới 23, nhưng khi bác polar với hàm (polar pt (+ 3.2 (* 0.25 i)) dis_min) thì có chắc chắn các điểm tmp này phân bố đều đủ một vòng quanh pt hay không ??? Các góc phân bố sẽ là 3.2, 3.45, 3.7, 3.95, 4.2, 4.45, 4.7, 4.95, 5.2, 5.45, 5.7, 5.95, 6.2, 6.45,.........., 8.95 (radian)
Do đó đây cũng có thể là nguyên nhân dẫn tới bị sót boundary bác ạ.

Rất mong bác giải đáp sớm để cái sự mót của mình được hanh thông bác nhé.
Cám ơn bác trước.

Chào bác phamthanhbinh, Cám ơn bác đã góp ý.
sorry, cái biến k tôi quên xóa, (* 0.25 i) đổi thành (* 0.26 i) k/quả cũng không khá hơn là mấy.
Vấn đề bị sót boundary là do ở bước 1 thuật toán chưa tốt bác ạ.
Tôi nghĩ là giá trị góc ban đầu 3.2 trong công thức (+ 3.2 (* 0.25 i)) phải thay đổi theo từng điểm khác nhau thì k/quả sẽ khá hơn ?!
- nếu sau khi tìm được boundary đầu tiên, mình tiếp tục vòng lặp thì nhiều khả năng sẽ bị trùng boundary.
Vâng, việc lựa chọn giữa bị sót boundary và trùng boundary là vấn đề khó khăn.

...
Có nhẽ bác lại bị dính ở chỗ các boundary có chứa arc rồi bác ạ. Khi boundary có chứa arc thì bác sẽ phải tạo region rồi lại explode nó mới được bác ạ.
....

List vẫn tạo được boundary có chứa arc bác a.
nhờ bác k/tra lại dùm.
  • 1