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

#3221 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 28 March 2011 - 04:56 PM

Hề hề hề,
Chưa hiểu ý của bạn yêu cầu
2.Lisp hỏi chọn hướng (góc)của toạ độ xuất ra; góc này có thể nhập hoặc chọn bằng cách pick điểm.

Rất cám ơn "phamthanhbinh" đã quan tâm. Cụ thể hoá yêu cầu trong file
Toa do
Thân !
  • 0

#3222 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 28 March 2011 - 10:51 PM

Rất cám ơn "phamthanhbinh" đã quan tâm. Cụ thể hoá yêu cầu trong file
Toa do
Thân !

Mạn phép tác giả mình sửa giúp bạn

(defun C:td (/ diem PT1 PT2 PT3 tapx tapy 
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22 lstname)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(if (null h)(setq h 5))
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h1 (getreal (strcat "\nNhap chieu cao chu: < " (rtos h 2 0) " >"))
ang (getangle "\nNhap goc nghieng text :")
)
(if h1 (setq h h1))
(while
(setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
(progn
(setq EL (entlast))
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
y (rtos(car diem) 2 4)
x (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat "P" (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(command "_rotate" (acet-list-to-ss Listname) "" diem (polar diem ang 1))
(setq listName nil)
(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 ""
"text" "j" "m" p22 h 0 "X"
"text" "j" "m" p33 h 0 "Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

P/S : dù sao thì mình cũng hơi buồn, vì đây không phải là yêu cầu khó, bạn cũng đang là 1 lisper, câu hỏi này bạn cũng hỏi ở topic của chính lisp này, mình cũng có đọc thấy nhưng "lờ" đi, k ngờ sau 1 tjan vẫn thế
  • 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


#3223 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 28 March 2011 - 11:00 PM

P/S : dù sao thì mình cũng hơi buồn, vì đây không phải là yêu cầu khó, bạn cũng đang là 1 lisper, câu hỏi này bạn cũng hỏi ở topic của chính lisp này, mình cũng có đọc thấy nhưng "lờ" đi, k ngờ sau 1 tjan vẫn thế

Nếu vậy xin lỗi bạn, thực tế mình đã có sửa qua nhưng ko được theo ý. Vi mình mới quan tâm và học lisp nên chỉ có thể can thiệp vào những đoạn mã lisp tương đối đơn giản và do thời gian hạn chế.
Cám ơn "ketxu" !
Thân !
  • 0

#3224 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 29 March 2011 - 11:59 AM

Em đã đọc bài viết trên rồi nhưng khi sử dụng chọn đối tượng không được. Em đang nối các đường đồng mức 2d polyline nên có rất nhiều đường trùng nhau 1 phần. Sử dụng qua overkill thì quá lâu :wacko:

Hề hề hề,
Không rõ bạn có am tường về lisp không nhưng qua bài pót của bạn mình thấy rằng, có nhẽ bạn không sử dụng dược lisp trên là do các đường đồng mức của bạn là các 3d polyline chứ không phải LWpolyline bạn ạ.
Vì thế nếu bạn muốn có được cái bạn cần thì có nhẽ bạn nên post một bản vẽ của bạn có chứa các đường như vậy để mọi người ngâm cứu thử và cũng nên nói rõ khi nào thì cần xóa. Khái niệm trùng ở đây của bạn là thế nào, trùng các hình chiếu trên mặt phẳng vẽ hay trùng hoàn toàn cả về các vertex của nó. Theo mình nghĩ thì có nhẽ bạn muốn xóa các phần hình chiếu trùng nhau của các đường đồng múc mà như vậy thì có ổn không vì bản thân mỗi đường đồng mức là một polyline riêng biệt có cao độ đồng nhất. khi xóa một phần nào đó của cái đường đồng mức này đi thì liệu nó có còn là cái đường đồng mức bạn cần hay không???
Rất mong bạn nói rõ mới có thể giúp bạn được. Tốt nhất bạn nên gửi file bản vẽ trước khi xử lý và file bản vẽ kết quả sau xử lý để mọi người hiểu và dễ dàng giúp bạn.
Nếu bạn có thể thì dựa vào cái thuật toán mình đã sử dụng trong cái lisp bạn đã đọc, bạn thử áp dụng vào các 3dpolyline của bạn xem sao. Như vậy có nhẽ sẽ được đúng với yêu cầu của bạn hơn, vì có thể mọi người chưa hiểu đúng ý bạn.
Hề hề hề,
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3225 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 March 2011 - 12:07 PM

Nếu vậy xin lỗi bạn, thực tế mình đã có sửa qua nhưng ko được theo ý. Vi mình mới quan tâm và học lisp nên chỉ có thể can thiệp vào những đoạn mã lisp tương đối đơn giản và do thời gian hạn chế.
Cám ơn "ketxu" !
Thân !

Có lẽ do lisp này dài dài vậy nên bạn nghĩ nó khó, thực chất cũng không đến nỗi khó lắm đâu. Cái bạn cần là 1 tờ giấy để ghi lại "diem" nó ở chỗ nào, lệnh này nó sẽ ghi text ở đâu, lệnh này nó làm cái j... và 1 chút kiên nhẫn, đọc từ trên xuống dưới.Tất cả đều là các lệnh rõ ràng và dễ hiểu.
Mình gọi là sửa cho nó oai, nhưng thực chất chỉ sửa 2 từ (x thành y và ngược lại), thêm 4 dòng nữa thôi (Nhập góc, lấy ename tất cả từ khi bắt đầu vẽ, quay tập ename đó), nên mình nghĩ nếu bạn tâm huyết với vấn đề của mình, chắc chắn bạn sẽ làm được.
Chúc bạn thành công và thổi nhiệt huyết sang các CADman khác :)
  • 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


#3226 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 29 March 2011 - 12:12 PM

Mạn phép tác giả mình sửa giúp bạn

P/S : dù sao thì mình cũng hơi buồn, vì đây không phải là yêu cầu khó, bạn cũng đang là 1 lisper, câu hỏi này bạn cũng hỏi ở topic của chính lisp này, mình cũng có đọc thấy nhưng "lờ" đi, k ngờ sau 1 tjan vẫn thế

hề hề hề,
Chào bác Ketxu,
Có nhẽ bác hơi vội nên hình như có quên chút xíu cái yêu cầu thứ hai của bạn Nguyenngocson thì phải.
Bác đã cho nhập góc nghiêng text nhưng khi tạo text thì bác vẫn để góc text y như cụ : (command "text" "j" "BL" PT1 h 0 x) và ......
Bác xem lại mấy chỗ này nhé.
Hề hề hề,
@Nguyenngocson: Dựa vào bài viết của bác ketxu và của mình bạn có thể tự chỉnh chút xíu được không??? Mình tin là bạn sẽ thành công.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3227 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 29 March 2011 - 12:21 PM

Có lẽ do lisp này dài dài vậy nên bạn nghĩ nó khó, thực chất cũng không đến nỗi khó lắm đâu. Cái bạn cần là 1 tờ giấy để ghi lại "diem" nó ở chỗ nào, lệnh này nó sẽ ghi text ở đâu, lệnh này nó làm cái j... và 1 chút kiên nhẫn, đọc từ trên xuống dưới.Tất cả đều là các lệnh rõ ràng và dễ hiểu.
Mình gọi là sửa cho nó oai, nhưng thực chất chỉ sửa 2 từ (x thành y và ngược lại), thêm 4 dòng nữa thôi (Nhập góc, lấy ename tất cả từ khi bắt đầu vẽ, quay tập ename đó), nên mình nghĩ nếu bạn tâm huyết với vấn đề của mình, chắc chắn bạn sẽ làm được.
Chúc bạn thành công và thổi nhiệt huyết sang các CADman khác :)

Hề hề hề,
Ây da, mình đọc lướt lướt nên hổng thấy cái rotate của bác. Tuy nhiên giá như bác rotate từng thằng ngay trong hàm command "text".... có nhẽ se đúng ý bạn ấy hơn, vì khi rotate cả đám quanh một cái tâm là điểm thì các text sẽ quay với bán kính quay khác nhau bác ạ và không khéo thì nó trốn mất tiêu luôn...
Hề hề hề.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3228 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 March 2011 - 01:29 PM

^^ Tất nhiên là e chỉ mới chọn lại đám râu ria đó rồi quay thôi, và chắc chắn sẽ chậm hơn là vẽ ngay ban đầu, và lỗi thì... :"> Chứ vẽ thì coding hơi lâu hơn ^^.Và việc đó xin nhường lại bạn NguyenNgocSon ^^
  • 2

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


#3229 daythung777

daythung777

    biết zoom

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

Đã gửi 29 March 2011 - 04:37 PM

Hề hề hề,
Không rõ bạn có am tường về lisp không nhưng qua bài pót của bạn mình thấy rằng, có nhẽ bạn không sử dụng dược lisp trên là do các đường đồng mức của bạn là các 3d polyline chứ không phải LWpolyline bạn ạ.
Vì thế nếu bạn muốn có được cái bạn cần thì có nhẽ bạn nên post một bản vẽ của bạn có chứa các đường như vậy để mọi người ngâm cứu thử và cũng nên nói rõ khi nào thì cần xóa. Khái niệm trùng ở đây của bạn là thế nào, trùng các hình chiếu trên mặt phẳng vẽ hay trùng hoàn toàn cả về các vertex của nó. Theo mình nghĩ thì có nhẽ bạn muốn xóa các phần hình chiếu trùng nhau của các đường đồng múc mà như vậy thì có ổn không vì bản thân mỗi đường đồng mức là một polyline riêng biệt có cao độ đồng nhất. khi xóa một phần nào đó của cái đường đồng mức này đi thì liệu nó có còn là cái đường đồng mức bạn cần hay không???
Rất mong bạn nói rõ mới có thể giúp bạn được. Tốt nhất bạn nên gửi file bản vẽ trước khi xử lý và file bản vẽ kết quả sau xử lý để mọi người hiểu và dễ dàng giúp bạn.
Nếu bạn có thể thì dựa vào cái thuật toán mình đã sử dụng trong cái lisp bạn đã đọc, bạn thử áp dụng vào các 3dpolyline của bạn xem sao. Như vậy có nhẽ sẽ được đúng với yêu cầu của bạn hơn, vì có thể mọi người chưa hiểu đúng ý bạn.
Hề hề hề,
Chúc bạn vui.


Cảm ơn bạn phamthanhbinh đã quan tâm.

Khi sồ hóa đường đồng mức mất rất nhiều thời gian nên trước khi định nghĩa mình nối trước vì vậy các đường đồng mức chưa có cao độ. Còn đây là file bạn xem thử
http://www.mediafire...3q77b5j0t7fqcqv
  • 0

#3230 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 March 2011 - 10:55 PM

Mình đã thử so sánh kết quả chạy lisp (tìm overlay) so với Overkill thì Overkill vẫn nhanh hơn bạn à ^^
  • 2

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


#3231 daythung777

daythung777

    biết zoom

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

Đã gửi 30 March 2011 - 07:40 AM

Nhanh hơn nhưng khi quyét nhiều đối tượng thì rất lâu mà có thể treo máy luôn ( có thể máy mính yếu :mellow: )

cảm ơn bạn rất nhiều !!
  • 0

#3232 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 March 2011 - 08:18 AM

Vì polyline của bạn có khá nhiều vertex, sau khi kiểm tra over (việc này Overkill làm rất nhanh ), express còn rebuild lại Pline đó ^^, nên việc lâu là đương nhiên. Cho nên, bạn có thể tách ra từng vùng mà làm 1 (máy yếu )
  • 2

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


#3233 daythung777

daythung777

    biết zoom

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

Đã gửi 30 March 2011 - 08:29 AM

Chắc phải làm dậy thôi :lol: , cảm ơn tất cả
  • 0

#3234 daythung777

daythung777

    biết zoom

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

Đã gửi 30 March 2011 - 09:12 AM

Cách làm overkill không rebuil pline là phá các polyline ra ( lệnh x) , sau đó nối lại ( lệnh pe ), cách này nhanh hơn nhưng phải di chuyển ra chổ khác :unsure:
  • 0

#3235 kamezoko

kamezoko

    biết vẽ line

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

Đã gửi 30 March 2011 - 08:43 PM

@TUE_NV: không ngờ có lệnh hay thế này mà lâu ni không biết. Cảm ơn anh 1 lần nưa
@kamezoko: Cách làm của anh TUE_NV có thể giải quyết được 2 yêu cầu của bạn
Mình hoàn chỉnh cho bạn rồi nè.


;;;-------------------------------------------------------------
(defun TBCong (x1 x2) (/ (+ x1 x2) 2)) ;;;Trung binh cong
;;;-------------------------------------------------------------
(defun MidP (p1 p2) ;;;Midpoint
(list (TBCong (car p1) (car p2)) (TBCong (cadr p1) (cadr p2)) (TBCong (caddr p1) (caddr p2)))
)
;;;-------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun etype (e) (cdr (assoc 0 (entget e)))) ;;;Entity type
;;;-------------------------------------------------------------
(defun dim2p (p1 p2 s h) ;;;Dimaligned 2 Point
(command "dimaligned" p1 p2 (polar (MidP p1 p2) (+ (angle p1 p2) (/ pi 2)) s))
(command "DIMOVERRIDE" "dimtxt" h "DIMDSEP" "," "" (entlast) "")
)
;;;-------------------------------------------------------------
(defun dimLine(e s h) ;;;Dimaligned Line
(dim2p (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e))) s h)
)
;;;-------------------------------------------------------------
(defun dimPline(e s h) ;;;Dimaligned PLine
(setq Lp (getvert e) i 0)
(repeat (1- (length Lp))
(dim2p (nth i Lp) (nth (1+ i) Lp) s h)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------
(defun C:AD( / ss s oldos e) ;;;AutoDimaligned Line & Pline
(vl-load-com)
(if (not s0) (setq s0 10))
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE")))
s (getdist (strcat "\nKhoang cach tu doi tuong den duong kich thuoc <" (rtos s0) ">:"))
oldos (getvar "osmode")
)
(if (not s) (setq s s0) (setq s0 s))
(if (not caotext1) (setq caotext1 2.00))
(setq caotext (getreal (strcat "\n Nhap chieu cao Text <" (rtos caotext1 2 2) ">:")))
(if (not caotext) (setq caotext caotext1) (setq caotext1 caotext))
(setvar "osmode" 0)
(while (setq e (ssname ss 0))
(if (= (etype e) "LINE") (dimLine e s caotext) (dimPline e s caotext))
(ssdel e ss)
)
(setvar "osmode" oldos)
(princ)
)

cám ơn các anh..các anh giúp em thêm 1 chút nửa nhe...
em muốn sau khi lisp ghi kích thướt xong thì nó tự nổ ra thành mtext (explode)
em cám ơn trước.. :D
  • 0

#3236 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 March 2011 - 08:58 PM

Mình mới thấy có người vui tính như bạn đấy ^^
Bạn thêm dòng này

(command "_explode" (entlast))


vào sau dòng này :

(command "DIMOVERRIDE" "dimtxt" h "DIMDSEP" "," "" (entlast) "")


  • 1

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


#3237 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 31 March 2011 - 11:51 AM

Cảm ơn bạn phamthanhbinh đã quan tâm.

Khi sồ hóa đường đồng mức mất rất nhiều thời gian nên trước khi định nghĩa mình nối trước vì vậy các đường đồng mức chưa có cao độ. Còn đây là file bạn xem thử
http://www.mediafire...3q77b5j0t7fqcqv

Bạn xài thử cái này coi có ổn hơn thằng overkill không nhé. Mình chạy thử thấy cũng không quá chậm song có tí nhược điểm là nếu như cái đoạn overlay không trùng nhau hoàn toàn sẽ bị lỗi. Khi đó phải sửa bằng tay cái chỗ bị lỗi đó.

(defun gver ( e / enlist e2 enlist2)
(setq enlist(entget e))
(setq ptList(list))
(setq e2 (entnext e))
(setq enlist2 (entget e2))
(while (not (equal (cdr(assoc 0 (entget(entnext e2))))"SEQEND"))
(setq e2(entnext e2))
(setq enlist2(entget e2))
(if(/= 16 (cdr(assoc 70 enlist2)))
(setq ptList(append ptList (list (cdr(assoc 10 enlist2)))))
)
)
ptlist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chlst ( lst )
(setq lst2 (list))
(while (/= (cdr lst) nil)
(setq lst2 (append lst2 (list (list (car lst) (cadr lst)))))
(setq lst (cdr lst))
)
lst2
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:ovkpl (/ olcol ss ss1 en e1 plst plst1 pls1 pls2 i col ans )
(vl-load-com)
(command "undo" "be")
(setq olcol (getvar "cecolor"))
(setq ss (ssget (list (cons 0 "POLYLINE") (cons 8 "DONG MUC BANG DO")))
;;;;ssl (acet-ss-to-list ss)
;;;;n (sslength ss)
;;;i 0
)

(while (/= (sslength ss) 0)
(setq en (ssname ss 0))
;;;;(while (/= ss nil)
(setq ss1 (ssdel en ss)
plst (gver en)
pls1 (chlst plst))
(if (/= (sslength ss1) 0)
(progn
(setq i 0)
(while (< i (sslength ss1))
(setq e1 (ssname ss1 i))
(setq col (cdr (assoc 62 (entget e1))))
(setq plst1 (gver e1))
(setq pls2 (chlst plst1))
(setq ans nil)
(if (or (equal plst plst1) (equal plst (reverse plst1)))
(command "erase" e1 "")
(foreach cp1 pls1
(foreach cp2 pls2
(if (or (equal cp1 cp2) (equal cp1 (reverse cp2)))
(progn
(setq plst1 (vl-remove (cadr cp2) (vl-remove (car cp2) plst1)))
(setq ans T)
)

)
)
)
)
(if (= ans T)
(progn
(setq ss1 (ssdel e1 ss1))
(command "erase" e1 "")
;;;;;(command "regenall")
(setvar "cecolor" (rtos col 2 0))
(command "pline" )
(foreach pt plst1
(command pt)
)
(command "")
)
)
(setq i (1+ i))
)
)
)
(setq ss ss1)
;;;;;;;)

)
(setvar "cecolor" olcol)
(command "undo" "e")
(princ)
)


Có gì xin cứ phản hồi nhé. Mình viết cái này là dựa trên bản vẽ của bạn, nó chỉ xét các polyline trên lớp DONG MUC BANG DO. Kết quả trả về chỉ còn 1 phần là polyline còn phần kia là LWpolyline . Hơi khác với cái mẫu bạn gửi là tất cả đều là lwpolyline.
Trong cái mẫu bạn gửi, vẫn còn sót phần trùng đó.
Chúc bạn vui.
  • 3
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3238 daythung777

daythung777

    biết zoom

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

Đã gửi 31 March 2011 - 04:41 PM

:rolleyes: , Kết quả giống như bạn đã nói, những đoạn khồng trùng nhau hoàn toàn, bị đẩy lên trên . Mình nắm kéo xuống được mà đau cần phải sửa lại,Nhưng những đoạn pline sát nhau nó lại dính lại với nhau, bạn xem lai giúp :D

Cảm ơn bạn rất nhiều !!
  • 0

#3239 truongvinhks

truongvinhks

    Chưa sử dụng CAD

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

Đã gửi 01 April 2011 - 01:20 PM

có ai biết về gis không,mình muốn tao 1 lisp như thế này.
- Khi mình kick vào 1 điểm đã có trên cad thì nó sẽ hiện ra thông tin của điểm đó như trong gis vậy
- thông tin hiện ra sẽ do ta nhập vào trước nên khi chi cần kick vào la nó sẽ hiện ra
Xin mọi người giúp đỡ.
  • 0

#3240 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 01 April 2011 - 02:27 PM

:rolleyes: , Kết quả giống như bạn đã nói, những đoạn khồng trùng nhau hoàn toàn, bị đẩy lên trên . Mình nắm kéo xuống được mà đau cần phải sửa lại,Nhưng những đoạn pline sát nhau nó lại dính lại với nhau, bạn xem lai giúp :D

Cảm ơn bạn rất nhiều !!

Hề hề hề,
Chưa hiểu bạn nói nó dính lại với nhau nghĩa là sao??? Bạn có thể gửi cái bản vẽ đó lên không. Có vậy mình mới biết đường để sửa bạn ạ...
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.