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

#2761 18011985

18011985

    biết lệnh properties

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

Đã gửi 29 November 2010 - 12:05 PM

Mình có 1 lsp yêu cầu như sau:
- Chọn 1 tổ hợp các text (số thực)
- Các text có toạ độ trùng nhau thì được cộng giá trị với nhau và ghi lại thành 1 text cùng vị trí và duy nhất.(xoá điểm trùng ghi 1 text mới ở vị trí cũ)
- Các text không trùng toạ độ thì bỏ qua.
Rất mong nhận được sự giúp đỡ của các bạn.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2762 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 29 November 2010 - 12:38 PM

Hic, topic chi mà dài 140 trang lận, vào chả biết đầu bài ở đâu ?
Đề nghị chia nhỏ ra theo đầu bài anh em mới đến mới hiểu các bác cãi nhau cái chi chứ !

Hề hề hề,
Vì đây là topic viết theo yêu cầu, mà cái yêu cầu của thành viên thì nó vô thiên lủng, vậy nên nó mới dài vầy. Nếu các thành viên chịu khó lập thành topic riêng thì hay quá. BQT do tôn trọng các thành viên nên cứ để nguyên yêu cầu của họ như vầy. Nếu bác có lòng muốn tìm hiểu, hãy chịu khó theo dõi topic thường xuyên sẽ hiểu mọi người đang thắc mắc cái chi mà.
Là người am hiểu mong bác hãy giúp đỡ mọi người nếu có thể và đừng quá câu nệ những tiểu tiết chưa hoàn thiện này.
Hề hề hề,
Chúc bác vui khi chơi cùng anh em trên diễn đàn....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2763 lacvanhoa

lacvanhoa

    biết vẽ line

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

Đã gửi 29 November 2010 - 12:41 PM

Cám ơn anh phamngoctu và các anh trên diễn đàn nhiều nhé. mong các anh sớm tìm ra lời giải giúp em
  • 0

#2764 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 29 November 2010 - 12:53 PM

Mình có 1 lsp yêu cầu như sau:
- Chọn 1 tổ hợp các text (số thực)
- Các text có toạ độ trùng nhau thì được cộng giá trị với nhau và ghi lại thành 1 text cùng vị trí và duy nhất.(xoá điểm trùng ghi 1 text mới ở vị trí cũ)
- Các text không trùng toạ độ thì bỏ qua.
Rất mong nhận được sự giúp đỡ của các bạn.

Chào bạn 18011985,
Yêu cầu của bạn không quá khó nhưng có nhẽ bạn nên nói rõ hơn một chút :
1/- Trùng tọa độ ở đây được hiểu thế nào??? Là trùng điểm đặt của text hay là trùng điểm mà text định biểu diễn (hình như trong nghề các bạn gọi là điểm mia miếc gì đó thì phải).
2/- Cộng giá trị tức là cộng giá trị số hay chỉ là cộng giá trị nội dung text (tỷ như text tổng bằng (strcat text1 text2 .... textn).

Tốt nhất bạn nên post một bản vẽ mẫu cái bạn đã có và cái kết quả bạn cần sẽ đỡ hiểu nhầm hơn và đỡ mất công làm đi làm lại 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.

#2765 18011985

18011985

    biết lệnh properties

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

Đã gửi 29 November 2010 - 01:16 PM

Chào bạn 18011985,
Yêu cầu của bạn không quá khó nhưng có nhẽ bạn nên nói rõ hơn một chút :
1/- Trùng tọa độ ở đây được hiểu thế nào??? Là trùng điểm đặt của text hay là trùng điểm mà text định biểu diễn (hình như trong nghề các bạn gọi là điểm mia miếc gì đó thì phải).
2/- Cộng giá trị tức là cộng giá trị số hay chỉ là cộng giá trị nội dung text (tỷ như text tổng bằng (strcat text1 text2 .... textn).

Tốt nhất bạn nên post một bản vẽ mẫu cái bạn đã có và cái kết quả bạn cần sẽ đỡ hiểu nhầm hơn và đỡ mất công làm đi làm lại bạn ạ...
Chúc bạn vui.

Hình đã gửi
Kết quả trước và sau khi dùng lsp
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2766 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 02:17 PM

1/- Diện tich không hoàn toàn đúng tức là nó có lấy được diện tích nhưng hình như không phải của đa giác lõm mà là cái diện tích của một hình bao nào đó chứa cái đa giác lõm đó bác ạ. Bởi vì khi mình kiểm tra lại cái list tập chọn lar thì mình thấy cái ename thì đúng là của đa giác lõm nhưng diện tích thì lại lớn hơn khá nhiều lần bác à.
2/- Không phải là do 2 diểm p1 p2 không thấy trên màn hình mà kể cả khi thấy. Mình thậm chí còn tạo thêm các điểm này để kiểm tra mà, Lý do thì mình chưa rõ lắm nên mới hỏi lại bác bác à.
3/- Sau khi tạo block thì tất cả các đối tượng trong vùng chọn ban đầu (tức là tập chọn ss) sẽ ẩn đi hết. Lúc này mới insert cái block b_temp vô và trên bản vẽ, vùng chọn lúc này chỉ có duy nhất cái block b_temp mà thôi. Phải không ạ???
Tiếp đó bác tạo thêm cái rectangle el1 để lấy boundary rồi xóa cái el1 này đi.
Như vậy trên bản vẽ về lý thuyết thì chỉ còn hai cái polyline được tạo ra bởi lệnh boundary mà thôi chứ bác. Một cái là của hình chữ nhật bao ngoài tạo ra, và một cái bao lấy biên dạng của block nằm bên trong hình chữ nhật bao đó.
Chính vì vậy mà bác mới giữ lại cái polyline có diện tích lớn thứ hai mà bác.
Vậy mà khi lấy (setq ss (ssget "w" p1 p2 (list (cons 0 "lwpolyline")))) thì lại xuất hiện các polyline nằm bên trong cái đường bao block nữa bác ạ. Mình đã thử bổ sung thêm thằng dxf 70 để chỉ chọn các polyline kín nó cũng vẫn chui vào. Mình đang nghĩ rằng hay là tại sau khi tạo block thì các đối tượng chỉ bị ẩn đi chứ không bị xóa hẳn. Do đó khi lấy tập chọn ss lần hai này nó lại lổm ngổm chui vào nằm ăn vạ hả bác. Nếu vậy có thể chơi một thằng (command "erase" ss "") sau khi tạo được block b_temp có được không bác hỉ???
Nếu được vậy có nhẽ sẽ tránh được các lỗi do mấy thằng polyline kím lõm có trong block gây ra như mình đã nói ở trên.
Mong bác quan tâm giải đáp giùm nhé.....
Thanks.

Để bác dễ hình dung, mình gửi bác cái kết quả kiểm tra quá trình chạy lisp của mình:
Đây là hình ảnh kết quả sau bước sắp xếp lại list lar bởi hàm (vl-sort.....)
Hình đã gửi
Các hình có màu vàng là mình đã di chuyển ra khỏi vùng chọn cho dễ nhìn.
Dưới đây là các ename của đối tượng màu vàng lấy từ ngoài vào trong (từ diện tích lớn nhất đến nhỏ nhất.)
Command: (car(entsel))

Select object:

Command: (car(entsel))

Select object:

Command: (car(entsel))

Select object:

Command: (car(entsel))

Select object:

Command: (car(entsel))

Select object:

Và đây là cái list lar được lấy ra sau khi đã sắp xếp để kiểm tra.

Command: !lar
((446497.0 ) (446497.0 )
(238269.0 ) (167058.0 ) (61075.0
))

Bác chú ý đối tượng có Entity name là là đối tượng đa giác lõm có diện tích nhỏ nhất trong các polyline kín. Vậy nhưng trong list lar thì nó lại đứng thứ 2 và có diện tích bằng với cái khung chữ nhật bao có diện tích lớn nhất là 446997.0 ???
Cũng vì vậy trong trường hợp này kết quả sẽ không có cái đường bao có entyti name là do nó đã bị xóa ở các bước tiếp theo bác ạ.

Tuy nhiên nếu bác insert một block b_temp khác rồi explode nó ra và chạy lisp thì nó lại cho kết quả khá ngon lành với cái list lar chỉ còn đúng hai đối tượng như mình đã nói phía trên.
Và đó là điều mình chưa hiểu nên mới mày mò tìm hiểu như trên.

Một phát hiện nữa của mình trong quá trình mày mò là khi bác dùng hàm (vla-get-area ob) thì diện tích lấy ra được làm tròn đến hàng đơn vị, còn nếu dùng (command "area" "o" .....) thì diện tích cho ra số lẻ tới 4 chữ số thập phân. Việc này tuy không quá quan trọng nhưng nếu bác giải thích được để mình nắm rõ hơn về các hàm này thì rất cám ơn bác.
Khi dùng hàm (command "area" "o" ...) thì mình có diện tích của đối tượng đa giác lõm là Area = 11477.3954 bác ạ. Theo mình nghĩ có nhẽ cái diện tích này mới là đúng của đa giác lõm.

Một điểm nữa có nhẽ bác nhầm trong lisp là việc lấy cái điểm p. Bác đặt (setq p (polar p1 (/ pi 4) 25)) theo mình phải là (setq p (polar p2 (/ pi 4) 25)) mới chuẩn bác ạ vì nếu lấy mốc p1 thì có thể p sẽ chui vào bên trong cái block của bác mất.

Hề hề hề, vì mình đang đi mót nên nếu có chỗ nào ngô nghê mong bác đừng cười và cố gắng giải thích giùm mình nhé.
Cám ơn bác nhiều....

Chào Bác Bình!
1. À ý bác là như vậy.Chính em chạy lisp cũng bị trường hợp như vậy rồi. Ở cái lisp đầu tiên em post cho bạn thì em dùng (setq rm (cadr (caddr lar))) lấy phần tử thứ 3 thì lisp mới chạ đúng trong cá hình của bạn đó up lên. (em cũng chưa hiểu và giải thích được vấn đề này).
2. Theo em thấy như hình của bác up lên thì hình như lisp chạy lỗi và chưa chạy xong thì phải. (block chưa được insert vào thì phải và tập chọn ss chưa được xoá đi)
3. Sau khi tạo block không phải các đối tượng đó bị ẩn đi đâu bac ạ mà nó đã bị xoá hẳn đi rồi. Các pline kín tồn tại là do dùng lệnh Boundary nó sẽ tạo ra các boundary nữa (giống như hatch với tuỳ chọn normal trong mục islands). Em không biết biến hệ thống nào giúp cái boundary này giống như hatch với tuỳ chọn outer thì sẽ không tạo ra các đường boundary không như ý muốn nữa.
Còn dòng (setq p (polar p1 (/ pi 4) 25)) là p1 đấy không phải p2 đâu Bác ạ. Vì ngay từ đầu điểm p1 này đã được setq lại rồi bác đọc lại sẽ rõ. Diểm p1 p2 lúc này không còn là rectang bao ngoài của đối tượng cọn nữa mà nó đã được offset ra một khoảng rồi.
Hề hề về độ ngô nghê thì em giỏi hơn bác nhiều.
  • 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!

#2767 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 02:21 PM

Hình đã gửi
Kết quả trước và sau khi dùng lsp

Chào bạn 18011985!
Cái này thì đâu có khó. Mình nghĩ với "trình" viết lisp của bạn thì cái này đâu thành vấn đề.
Mà bạn nên up file lên để người viết còn lấy cái mà test.
  • 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!

#2768 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 29 November 2010 - 02:26 PM

Hình đã gửi
Kết quả trước và sau khi dùng lsp

Chào bạn 18011985,
Bạn dùng thử rồi cho ý kiến nhé.

(defun c:ctxt ( / oldos ss1 ss2 els p1 t1 t2 )
(vl-load-com)
(setq oldos (getvar "osmode")
(setvar "osmode" 0)
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text")))))
(foreach x ss1
(setq els (entget x)
p1 (cdr (assoc 10 els))
t1 (atof (cdr (assoc 1 els)))
)
(if (/= t1 0.0)
(progn
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
(if (/= ss2 nil)
(progn
(foreach y ss2
(setq t2 (atof (cdr (assoc 1 (entget y)))))
(if (/= t2 0.0)
(progn
(setq t1 (+ t1 t2))
(command "erase" y "")
)
)
)
(setq els (subst (cons 1 (rtos t1 2 0)) (assoc 1 els) els))
(entmod els)
)
)
)
)
)
(setvar "osmode" oldos)
)

  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2769 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 02:30 PM

Theo tôi thì giải bài toán này cũng tương đối dễ thôi là như thế này :
1. Người dùng chọn điểm để tạo Boundary lô đất cần làm sổ thửa đất ==> tạo polyline A kín của thửa đất
2. Lấy list điểm dt A vừa tạo (ví dụ như n điểm)
3. Dùng hàm xác định vùng bắt điểm theo từng cạnh của lô đất. Ví dụ như lô đất có 6 điểm thì sẽ có (6-1)=5 vùng kín để chọn TEXT khoang vùng để chọn tên của người hàng xóm cùng lô đất
4. Lọc TEXT trong vùng chọn trên cơ sở chỉ chọn 1 TEXT có vị trí gần nhất cạnh chọn của lô đất ==> sẽ được TEXT tên hàng xóm
....
Bài toán ra như ý
Không biết là ý kiến các bác thế nào

Chào Bác VUVUZELA!
đúng như Bác Bình nói việc diện tích các thửa đất có diện tích không đều có khi tên của CSD đất lân bang lại xa hơn thử không giáp ranh với nó. Với lại khi vẽ một số đường biên của thửa đất không được ngắt tại điểm giao -> lấy số thủa xung quanh = tổng điểm - 1 bị sai.
Mong các anh em trên diễn đàn có thuật toán gì hay cùng đưa lên tranh luận.
  • 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!

#2770 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 02:36 PM

Chào bạn 18011985,
Bạn dùng thử rồi cho ý kiến nhé.


(defun c:ctxt ( / oldos ss1 ss2 els p1 t1 t2 )
(vl-load-com)
(setq oldos (getvar "osmode")
(setvar "osmode" 0)
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text")))))
(foreach x ss1
(setq els (entget x)
p1 (cdr (assoc 10 els))
t1 (atof (cdr (assoc 1 els)))
)
(if (/= t1 0.0)
(progn
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
(if (/= ss2 nil)
(progn
(foreach y ss2
(setq t2 (atof (cdr (assoc 1 (entget y)))))
(if (/= t2 0.0)
(progn
(setq t1 (+ t1 t2))
(command "erase" y "")
)
)
)
(setq els (subst (cons 1 (rtos t1 2 0)) (assoc 1 els) els))
(entmod els)
)
)
)
)
)
(setvar "osmode" oldos)
)

Cái này em nghĩ Bác viết theo cái lisp trước mà Bác vừa viết xong đấy. Tức là chọn thằng nào xử luôn thằng đó sẽ giảm time chạy lisp.
  • 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!

#2771 18011985

18011985

    biết lệnh properties

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

Đã gửi 29 November 2010 - 03:19 PM

Chào bạn 18011985,
Bạn dùng thử rồi cho ý kiến nhé.


(defun c:ctxt ( / oldos ss1 ss2 els p1 t1 t2 )
(vl-load-com)
(setq oldos (getvar "osmode")
(setvar "osmode" 0)
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text")))))
(foreach x ss1
(setq els (entget x)
p1 (cdr (assoc 10 els))
t1 (atof (cdr (assoc 1 els)))
)
(if (/= t1 0.0)
(progn
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
(if (/= ss2 nil)
(progn
(foreach y ss2
(setq t2 (atof (cdr (assoc 1 (entget y)))))
(if (/= t2 0.0)
(progn
(setq t1 (+ t1 t2))
(command "erase" y "")
)
)
)
(setq els (subst (cons 1 (rtos t1 2 0)) (assoc 1 els) els))
(entmod els)
)
)
)
)
)
(setvar "osmode" oldos)
)

lsp thiếu 1 dấu ngoặc ở (setq oldos (getvar "osmode")) và chạy lsp báo lỗi
; error: no function definition: ACET-SS-TO-LIST
Check lại hộ mình nhé
@Phamngoctukt trình của mình thì cũng viết được nhưng mình bị lỗi thời gian chạy đang loay hoay. Nên nhờ các bạn thử tìm con đường khác. Vlide của mình sau khi chạy bị báo lỗi 1 nhát giờ đang cài lại CAD hix
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2772 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 03:49 PM

; error: no function definition: ACET-SS-TO-LIST

Bạn bổ xung thêm (vl-load-com).
  • 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!

#2773 18011985

18011985

    biết lệnh properties

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

Đã gửi 29 November 2010 - 04:02 PM

Bạn bổ xung thêm (vl-load-com).

không thiếu (vl-load-com). Nó không nhận được công thức acet-ss-to-list
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2774 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 04:06 PM

không thiếu (vl-load-com). Nó không nhận được công thức acet-ss-to-list

Thế thì bạn cài lại express tool. Trước mình cũng bị lỗi này.
  • 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!

#2775 18011985

18011985

    biết lệnh properties

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

Đã gửi 29 November 2010 - 04:46 PM

Chào bạn 18011985,
Bạn dùng thử rồi cho ý kiến nhé.


(defun c:ctxt ( / oldos ss1 ss2 els p1 t1 t2 )
(vl-load-com)
(setq oldos (getvar "osmode")
(setvar "osmode" 0)
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text")))))
(foreach x ss1
(setq els (entget x)
p1 (cdr (assoc 10 els))
t1 (atof (cdr (assoc 1 els)))
)
(if (/= t1 0.0)
(progn
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
(if (/= ss2 nil)
(progn
(foreach y ss2
(setq t2 (atof (cdr (assoc 1 (entget y)))))
(if (/= t2 0.0)
(progn
(setq t1 (+ t1 t2))
(command "erase" y "")
)
)
)
(setq els (subst (cons 1 (rtos t1 2 0)) (assoc 1 els) els))
(entmod els)
)
)
)
)
)
(setvar "osmode" oldos)
)

Trời chạy được 1 lúc nó xoá sạch text của mình mạc dù chẳng trùng tý tẹo tèo teo nào. Hu hu ngồi undo chít thui.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2776 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 29 November 2010 - 04:59 PM

Trời chạy được 1 lúc nó xoá sạch text của mình mạc dù chẳng trùng tý tẹo tèo teo nào. Hu hu ngồi undo chít thui.

Hê Hê thì ai bảo bạn không up file lên người viết lấy gì mà test. Xoá sạch là phải 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!

#2777 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 29 November 2010 - 05:24 PM

Trời chạy được 1 lúc nó xoá sạch text của mình mạc dù chẳng trùng tý tẹo tèo teo nào. Hu hu ngồi undo chít thui.

Hu hu hu,
Bạn nói sao mình chưa hiểu???
Đúng là mình không test được vì không có file, nhưng cái lisp này theo như mình viết thì nó chỉ xóa những thằng nằm trong list tập chọn ss2 thôi chứ.
Mà SS2 thì đã được hạn chế tới mức tối thiểu rồi mà :
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
Như vậy chỉ có thằng nào có điểm đặt trùng với diểm đặt p1 của text số trước đó mới có mặt trong lít này, hơn nữa nó chỉ bị xóa khi thỏa điều kiện nó cũng là một text số (if (/= (atof (cdr (assoc 1 (entget y)))) 0.0 ) cơ mà.
Khổ quá, giá như bạn có cái cho mình test trước có phải đỡ khổ không????
Thế undo không được hử bạn???
Thôi thì, hu hu với bạn cho vui vậy.
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.

#2778 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 29 November 2010 - 06:06 PM

Trời chạy được 1 lúc nó xoá sạch text của mình mạc dù chẳng trùng tý tẹo tèo teo nào. Hu hu ngồi undo chít thui.

Hề hề hề,
Đền cho bạn cái nè, chạy thử coi có cười nổi không nhé. Thôi nín đi mà.....

(defun c:ctxt ( / oldos ss1 ss2 els p1 t1 t2 )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text")))))
(While (/= ss1 nil)
(setq x (nth 0 ss1)
els (entget x)
p1 (cdr (assoc 10 els))
t1 (atof (cdr (assoc 1 els)))
)
(if (/= t1 0.0)
(progn
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 10 p1)))))
(if (/= ss2 nil)
(progn
(foreach y ss2
(if (not (equal x y))
(progn
(setq t2 (atof (cdr (assoc 1 (entget y)))))
(if (/= t2 0.0)
(progn
(setq t1 (+ t1 t2))
(command "erase" y "")
(setq ss1 (vl-remove y ss1))
)
)
)
)
)
(setq els (subst (cons 1 (rtos t1 2 0)) (assoc 1 els) els))
(entmod els)
)
)
)
)
(setq ss1 (vl-remove x ss1))
)
(setvar "osmode" oldos)
)


Mà cái nè là chỉ xài để cộng các TEXT thôi nghen. MTEXT thì chưa xét. và cũng chỉ cộng những thằng có chung điểm đặt mã dxf10 thôi nhé. Những cái khác để xét sau, nếu bạn Ok thì mới nói chuyện tiếp được. bằng không thì mình sẽ khóc thay bạn vậy. 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.

#2779 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 29 November 2010 - 06:49 PM

E sưu tầm được 1 lisp vẽ ký hiệu đối xứng.Nhưng khi vẽ xong nó không phải block,e lại không biết lisp.Nhờ các bác sửa giùm khi vẽ xong nó là 1 block.Thanks.
(DEFUN C:dx (/ CMD OSM OLDERR PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
SZ G45 G135 G90 G180 SS loi)
(defun loi (s)
(if (= s "Function cancelled")
(princ)
(princ (strcat "Error:" s))
)
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)
;;***************************************
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *error*
*error* loi)
(SETQ SZ (GETREAL "Size <1>:"))
(IF (= SZ nil) (SETQ SZ 100))
(SETQ G45 (/ PI 4))
(SETQ G135 (* 3 (/ PI 4)))
(SETQ G90 (- G45 (/ PI 2)))
(SETQ G180 (+ G135 (/ PI 2)))
(SETQ PT1 (GETPOINT "\nDiem doi xung:"))
(SETVAR "OSMODE" 0)
(SETQ PT2 (POLAR PT1 G45 (* 2 SZ)))
(SETQ PT3 (POLAR PT2 G90 (* 2 SZ)))
(SETQ PT4 (POLAR PT1 G45 (* 1 SZ)))
(SETQ PT5 (POLAR PT1 G135 (* 2 SZ)))
(SETQ PT6 (POLAR PT5 G180 (* 2 SZ)))
(SETQ PT7 (POLAR PT1 G135 (* 1 SZ)))
(SETQ PT8 (POLAR PT1 G45 (* -0.7 SZ)))
(SETQ PT9 (POLAR PT1 G135 (* -0.7 SZ)))
(PRINC "\nGoc quay:")
(SETQ SS (SSADD))
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "150" "")
(COMMAND "LINE" PT8 PT2 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PT9 PT5 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "COLOR" "7" "")
(COMMAND "SOLID" PT2 PT3 PT4 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "SOLID" PT5 PT6 PT7 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "ROTATE" SS "" PT1 PAUSE)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)

  • 0

#2780 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 29 November 2010 - 07:29 PM

E sưu tầm được 1 lisp vẽ ký hiệu đối xứng.Nhưng khi vẽ xong nó không phải block,e lại không biết lisp.Nhờ các bác sửa giùm khi vẽ xong nó là 1 block.Thanks.

(DEFUN C:dx (/ CMD OSM OLDERR PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 PT9
SZ G45 G135 G90 G180 SS loi)
(defun loi (s)
(if (= s "Function cancelled")
(princ)
(princ (strcat "Error:" s))
)
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)
;;***************************************
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *error*
*error* loi)
(SETQ SZ (GETREAL "Size <1>:"))
(IF (= SZ nil) (SETQ SZ 100))
(SETQ G45 (/ PI 4))
(SETQ G135 (* 3 (/ PI 4)))
(SETQ G90 (- G45 (/ PI 2)))
(SETQ G180 (+ G135 (/ PI 2)))
(SETQ PT1 (GETPOINT "\nDiem doi xung:"))
(SETVAR "OSMODE" 0)
(SETQ PT2 (POLAR PT1 G45 (* 2 SZ)))
(SETQ PT3 (POLAR PT2 G90 (* 2 SZ)))
(SETQ PT4 (POLAR PT1 G45 (* 1 SZ)))
(SETQ PT5 (POLAR PT1 G135 (* 2 SZ)))
(SETQ PT6 (POLAR PT5 G180 (* 2 SZ)))
(SETQ PT7 (POLAR PT1 G135 (* 1 SZ)))
(SETQ PT8 (POLAR PT1 G45 (* -0.7 SZ)))
(SETQ PT9 (POLAR PT1 G135 (* -0.7 SZ)))
(PRINC "\nGoc quay:")
(SETQ SS (SSADD))
(command "layer" "m" "ghichu" "c" "163" """")
(COMMAND "COLOR" "150" "")
(COMMAND "LINE" PT8 PT2 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PT9 PT5 "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "COLOR" "7" "")
(COMMAND "SOLID" PT2 PT3 PT4 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "SOLID" PT5 PT6 PT7 "" "")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "ROTATE" SS "" PT1 PAUSE)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(SETQ *error* OLDERR)
(PRINC)
)

Bạn hãy bổ sung đoạn code sau vào trong lisp của bạn dưới dòng (COMMAND "COLOR" "BYLAYER" "") và trên dòng (SETVAR "CMDECHO" CMD):

(command "-block" (getstring "\n Nhap ten block: ") (getpoint "\n Chon diem goc") ss "")

Chú ý là ten block phải không trùng với các block đã có trước.

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.