Đến nội dung


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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2847 replies to this topic

#541 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 21 October 2010 - 09:38 AM

Bạn nguyentuyen6, ơi,
Chu choa mình ngu quá, trong lisp đã có sẵn hàm nentsel cho phép bạn truy xuất ename của các đối tượng nằm trong block mà mình quên béng đi nên sinh ra cái củ chả giống ai.
Bạn chỉ cần đơn giản là:
nhập : (setq ent (car (nentsel ))) vào dòng command.
Sau đó enter và chọn vào đối tượng khung màu vàng của bạn là nó cho bạn cái ename của khung liền mà.
Hề hề hề, chúc bạn vui.

Cái này cũng có thể dúng hàm nentselp cũng được bác ạ. Nhưng yêu cầu ở đây là tìm hình chữ nhật lớn nhất trong Block mà trong nó không chứa đối tượng nào???
Cái trên chỉ đúng khi biết được bằng mắt thường thôi, chứ Lisp đâu có "mắt". Mình tìm cách gắn "mắt" cho nó bác ạ. :lol:
  • 1

#542 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 21 October 2010 - 09:42 AM

Hì hì. cảm ơn bác đã giúp e. Nhưng hàm entsel này mình phải có động tác chọn chính xác nó bác ạ. Ý em là chỉ cần entname của cái block thì nó sẽ trả về Rectang to nhất thuộc block đó mà bên trong rectang này không chứa bất kỳ đối tượng nào cả. Dùng nentsel cũng đc nhưng nó sẽ làm e phải thêm một bước chọn cái rectang đó>> không tiện.
Nghĩa là tạo 1 defun có đối số là entname của block. kqua trả về là entname của rectang kia.
  • 0

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


#543 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 21 October 2010 - 05:02 PM

Đúng là chưa ổn Bác ạ. Trong trường hợp này không dùng quay ngược thời gian được.
Bác nên duyệt qua block để lấy tên lấy điểm chèn rồi explode ra xong lại block lại như cũ là được.

Không sử dụng cách này được vì chưa thể lấy được Entity của đa giác lớn nhất không chứa đối tượng nào trong Block. Lý do như bác Bình đã nói

Hề hề hê,
Chào bác Tue_NV,
Quả có vậy thiệt, do mình cứ nghĩ là trước hay sau explode thì cái ename của đối tượng vẫn không thay đổi. Mình sẽ kiểm tra lại theo cách khác xem. Vấn đề của nó còn là chạy trên bản vẽ của bạn nguyentuyen6 thì nó trả ra đối tượng được , nhưng khi insert một block khác vô thì nó lại chết ngoéo không chịu chạy, mình đang kiểm tra mà chưa phát hiện lỗi bác ạ.
Thank bác đã giúp đỡ.
@bác Phamngoctukts: Có nhẽ mình sẽ kiếm cách khác chứ không chơi thằng explode nữa bác ạ......

Ta vẫn cứ chơi với bạn Explode bác ạ. Vì có bạn Explode thì bác mới chứng tỏ được trong đa giác lớn nhất đó không chứa đối tượng nào. Thể hiện qua code dưới đây :
Các bác thử nhé :

(defun c:gblk(/ plst Ld Ldent blk xp s p e )
(vl-load-com)
(setq plst '() Ld '() ldent '())
(setq blk (car(entsel"\n Chon Block :")))
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE")
(setq s (cdr (assoc 2 (entget blk))))
(setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
(setq plst (append plst (list e)))
(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
(setq Ld '())
(FOREACH x dsd
(setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
)
(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
(>= (cdr(assoc 90 el)) 3)
(vlax-curve-isClosed e)
(null (ssget "WP" Ld))
)
(setq Ldent (append Ldent (list e)))
)

                (setq e (entnext e))
            )
(if (> (length Ldent) 0)
(progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x))
(vla-get-area (vlax-ename->vla-object y))
)
)
))
   (alert (strcat "Da giac lon nhat ma trong do khong chua doi tuong nao"
(vl-princ-to-string (list(car Ldent)))))
)
(alert "Khong co Da giac lon nhat ma trong do khong chua doi tuong nao")
)

(command "erase" xp "")
    (command ".UNDO" "E")
)

  • 1

#544 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 21 October 2010 - 05:18 PM

E test thử và lsp chạy không đúng bác ợ. hihi. Entity name thì ra, nhưng mà chưa đúng
  • 0

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


#545 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 21 October 2010 - 05:29 PM

E test thử và lsp chạy không đúng bác ợ. hihi. Entity name thì ra, nhưng mà chưa đúng

Theo mình nghĩ thì bạn lấy entityname của cái rectang đó để lấy toạ độ đỉnh thôi đúng không. Nếu đúng thì có thể áp dụng cách thứ nhất của bác Bình sau khi đã lấy được toạ độ đỉnh thì undo lại. Nếu không phải thì bạn có thể nêu bạn lấy entity của rectang đó làm gì được không.
  • 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!

#546 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 21 October 2010 - 05:38 PM

Theo mình nghĩ thì bạn lấy entityname của cái rectang đó để lấy toạ độ đỉnh thôi đúng không. Nếu đúng thì có thể áp dụng cách thứ nhất của bác Bình sau khi đã lấy được toạ độ đỉnh thì undo lại. Nếu không phải thì bạn có thể nêu bạn lấy entity của rectang đó làm gì được không.

Đúng như bác nghĩ. hehe. E muốn lấy dùng hàm acet-ent-geomextents:diem thap nhat trai va cao nhat phai
  • 0

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


#547 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 21 October 2010 - 05:40 PM

E test thử và lsp chạy không đúng bác ợ. hihi. Entity name thì ra, nhưng mà chưa đúng

Bạn test thử chưa?
Tue_NV đổi độ rrộng của đa giác tìm được cho bạn dễ thấy nhé :
Đa giác tìm được đổi thành độ rộng 100 -> OK


(defun c:gblk(/ plst Ld Ldent blk xp s p e )
(vl-load-com)
(setq plst '() Ld '() ldent '())
(setq blk (car(entsel"\n Chon Block :")))
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE")
(setq s (cdr (assoc 2 (entget blk))))
(setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
(setq plst (append plst (list e)))
(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
(setq Ld '())
(FOREACH x dsd
(setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
)
(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
(>= (cdr(assoc 90 el)) 3)
(vlax-curve-isClosed e)
(null (ssget "WP" Ld))
)
(setq Ldent (append Ldent (list e)))
)

                (setq e (entnext e))
            )
(if (> (length Ldent) 0)
(progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x))
(vla-get-area (vlax-ename->vla-object y))
)
)
))
(vla-put-ConstantWidth (vlax-ename->vla-object (car Ldent)) 100)
   (alert (strcat "Da giac lon nhat ma trong do khong chua doi tuong nao"
(vl-princ-to-string (list(car Ldent)))))
)
(alert "Khong co Da giac lon nhat ma trong do khong chua doi tuong nao")
)
(command "ReGEN")
(command "erase" xp "")
    (command ".UNDO" "E")
)

  • 1

#548 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 21 October 2010 - 08:38 PM

Đúng rồi bác a, đc rồi!!Lúc chiều E test rồi!!! tại khi em vào trong block dùng hàm (entsel) để xem lại cái entname của cái rectang ý thì nó lại cho khác với cái thông báo của bác. Tại sao vậy bác nhở??
  • 0

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


#549 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 21 October 2010 - 09:28 PM

Đúng rồi bác a, đc rồi!!Lúc chiều E test rồi!!! tại khi em vào trong block dùng hàm (entsel) để xem lại cái entname của cái rectang ý thì nó lại cho khác với cái thông báo của bác. Tại sao vậy bác nhở??

Nếu đúng là bạn chỉ cần lấy toạ độ của cái rectang đó thôi thì có nhiều cách đơn giản hơn nhiều. Lúc tạo block bạn gán cho nó một layer khác đi. ngay sau khi explode bạn dùng (ssget "p" (list (cons 0 "lwpolyline") (cons 8 "layer"))) sẽ được cái selectionset của thằng rectang đó. Sau đó lấy toạ độ, sau khi lấy toạ độ thì undo lại. Mình nghĩ như vậy code sẽ ngắn hơn rất nhiều và tiện cho việc quản lý lisp của bạn.
  • 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!

#550 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 21 October 2010 - 09:46 PM

Đúng rồi bác a, đc rồi!!Lúc chiều E test rồi!!! tại khi em vào trong block dùng hàm (entsel) để xem lại cái entname của cái rectang ý thì nó lại cho khác với cái thông báo của bác. Tại sao vậy bác nhở??

Chào bạn nguyentuyen6,
Loay hoay hoài mình mới ra được cái củ..... lisp này. Bạn xài thử xem có ngon không hỉ????

(defun c:slk ( / )
(vl-load-com)

(setq ent (car (entsel "\n Chon block chua khung "))
elb (entget ent)
en (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 elb )))))
els (entget en)
plst (list)
en1 (entnext en)
pg (cdr (assoc 10 elb))
)
(while (/= en1 nil)
(setq els1 (entget en1))
(if (= (cdr (assoc 0 els1)) "LWPOLYLINE")
(progn
(setq obj (vlax-ename->vla-object en1)
dt (vlax-curve-getarea obj)
plst (append plst (list (list dt en1)))
)
)
)
(setq en1 (entnext en1))
)
(setq plst (vl-sort plst '(lambda (x1 x2) (>= (car x1) (car x2)))))
;;;;;;;;;;(setq enk (cadr (car (cddddr plst))))
(setq ssp (list)
m (length plst)
j 0
)
(while (< j m)
(command "undo" "be")
(setq en2 (nth j plst)
els2 (entget (cadr en2))
pll (list)

)
(foreach a els2
(if (= (car a) 10)
(progn
(setq pt (trans (cdr a) ent 0))
(setq pt (list (+ (car pt) (car pg)) (+ (cadr pt) (cadr pg)) (+ (caddr pt) (caddr pg))))
(setq pll (append pll (list pt )))
)
)
)
(command "explode" ent)
(if (= (setq ss (ssget "wp" pll)) nil)
(setq ssp (append ssp (list en2)))
)
(command "undo" "e")
(command "undo" 1)
(setq j (1+ j))
)
(setq ssp (vl-sort ssp '(lambda (y1 y2) (> (car y1) (car y2)))))
(setq enk (cadr (car ssp)))
enk
)


Thực tình ban đầu mình định không xài kiểu explode nữa, xong khổ nỗi bạn lại yêu cầu là không chứa đối tượng nào bên trong, thế nên nghĩ hoài chả được cách kiểm tra khi block không bị phá. Bởi vì khi đó toàn bộ khung chỉ có một đối tượng duy nhất. Thế nên cuối cùng lại phải dùng cách củ chuối ấy vậy.
Đến đ6ay lại vướng vì nếu chỉ ở cái bản vẽ bạn post thì Ok ngay nhưng khi insert các khung khác vô thì nó lại không ra. Tìm hoài mới vỡ ra là thằng cu LWPOLYLINE khi trả ra tọa độ đỉnh ở mã DXF10 thì nó trả tọa độ theo hệ tọa độ của đối tượng bạn ạ. Vậy là lại phải bổ sung thêm cái tọa độ của điểm insert block nữa mới ok. Khổ thế, nhưng đúng là cái khó nó lại ló được tí khôn bạn ạ.....
Hy vọng bạn hài lòng vời cái củ lisp này.

Mình chưa xem kỹ cái củ của bác Tue_NV cho bạn xong hy vọng cái củ ấy ngon hơn cái của mình và mình sẽ mót thêm được tí gì của bác ấy. Hề hề hề....

Bạn dùng hàm entsel thì không thể lấy được các ename của các phần tử bên trong block bạn ạ. Phải dùng hàm nentsel mới được 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.

#551 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 21 October 2010 - 10:15 PM

hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

@bác Thanhbinh:
Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe

E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???



(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE")
(setq s (cdr (assoc 2 (entget blk))))
(setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
(setq plst (append plst (list e)))
(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
(setq Ld '())
(FOREACH x dsd
(setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
)
(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
(>= (cdr(assoc 90 el)) 3)
(vlax-curve-isClosed e)
(null (ssget "WP" Ld))
)
(setq Ldent (append Ldent (list e)))
)
                (setq e (entnext e))
            )
(if (> (length Ldent) 0)
(progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x))
(vla-get-area (vlax-ename->vla-object y))
)
)
))
   (setq entrecblk (car Ldent))
)
)
(command "erase" xp "")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
(setq Rec (acet-ent-geomextents entrecblk)
pt1 (nth 0 Rec);lay dinh
pt2 (nth 1 Rec);lay dinh
i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
; (command "Line" pt1 pt2)
(KetThuc)
(princ "\n...Done...")
(princ)
);defun


Và khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx
  • 0

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


#552 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 21 October 2010 - 10:53 PM

hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

Hề hề nhưng ở cái block khung tên khác lại không có cái rectang như của bạn thì sao. Mình tưởng bạn dùng lisp này chỉ chuyên cho cái block khung tên của bạn.
BS: Mình có ý như thế này:
1. vẫn explode thằng block đó ra.
2. tạo boundary điểm pick là trọng tâm của block.
3. lấy toạ độ boundary vừa tạo
4. undo lại trạng thái ban đầu.
như vậy là code lại càng ngắn
  • 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!

#553 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 22 October 2010 - 02:48 AM

hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

@bác Thanhbinh:
Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe

E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???


(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE")
(setq s (cdr (assoc 2 (entget blk))))
(setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
(setq plst (append plst (list e)))
(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
(setq Ld '())
(FOREACH x dsd
(setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
)
(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
(>= (cdr(assoc 90 el)) 3)
(vlax-curve-isClosed e)
(null (ssget "WP" Ld))
)
(setq Ldent (append Ldent (list e)))
)
                (setq e (entnext e))
            )
(if (> (length Ldent) 0)
(progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x))
(vla-get-area (vlax-ename->vla-object y))
)
)
))
   (setq entrecblk (car Ldent))
)
)
(command "erase" xp "")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
(setq Rec (acet-ent-geomextents entrecblk)
pt1 (nth 0 Rec);lay dinh
pt2 (nth 1 Rec);lay dinh
i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
; (command "Line" pt1 pt2)
(KetThuc)
(princ "\n...Done...")
(princ)
);defun


Và khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx

Thực tình cũng hơi buồn vì bạn đã không đọc kĩ code của Tue_NV mà áp dụng 1 cách đúng đắn theo ý đồ của bạn.
Bạn thử cái này đã sửa lại cho bạn xem :

(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE")
(command "zoom" (car(acet-ent-geomextents blk)) (cadr(acet-ent-geomextents blk)))
(setq s (cdr (assoc 2 (entget blk))))
(setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
(setq plst (append plst (list e)))
(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
(setq Ld '())
(FOREACH x dsd
(setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
)
(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
(>= (cdr(assoc 90 el)) 3)
(vlax-curve-isClosed e)
(null (ssget "WP" Ld))
)
(setq Ldent (append Ldent (list (append (list Ld) (list e)))))
)
                (setq e (entnext e))
            )
(if (> (length Ldent) 0)
(progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object (cadr x)))
(vla-get-area (vlax-ename->vla-object (cadr y)))
)
)
))
   (setq entrecblk (car Ldent))
)
)
(command "erase" xp "")
(command "zoom" "p")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
(if entrecblk (progn
(setq Rec (car entrecblk)
pt1 (nth 0 Rec);lay dinh
pt2 (nth 2 Rec);lay dinh
i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
(command "Line" pt1 pt2 "")
(KetThuc)
(princ "\n...Done...")
)
(alert "Khong co Da giac lon nhat ma trong do khong chua doi tuong nao")
);
(princ)
);defun

@PhamngocTu : Sử dụng với mục đích như của bạn nguyentuyen6 thì explode ra cũng được. Cơ mà cái cách như trên chỉ có thể lấy thông tin thôi, chứ cập nhật và thay đổi thông tin thì không ổn. Cách hay nhất là nên thâm nhập vào kho dữ liệu của đối tượng và làm chủ nó.
  • 0

#554 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 22 October 2010 - 07:14 AM

Em sửa đc rồi bác tue à. he. tại e ẩu quá..
  • 0

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


#555 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 30 October 2010 - 02:26 PM

Các bác cho em hỏi 1 câu:

Em có 1 tập chọn TEXT = hàm ssget
Làm sao để lấy được 1 list entname của tất cả text. mà trong List đó entname đc sắp xếp lần lượt từ cao xuống thấp dần của tập chọn text đó. (điểm để so sánh cao và thấp là dựa vào điểm chèn của text đó. VD: trong trường hợp từ cao đến thấp là dựa vào tọa độ Y còn từ trái sang phải là dựa vào tọa độ X)
  • 0

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


#556 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 30 October 2010 - 03:15 PM

Các bác cho em hỏi 1 câu:

Em có 1 tập chọn TEXT = hàm ssget
Làm sao để lấy được 1 list entname của tất cả text. mà trong List đó entname đc sắp xếp lần lượt từ cao xuống thấp dần của tập chọn text đó. (điểm để so sánh cao và thấp là dựa vào điểm chèn của text đó. VD: trong trường hợp từ cao đến thấp là dựa vào tọa độ Y còn từ trái sang phải là dựa vào tọa độ X)

Chào bạn nguyentuyen6,
Dùng lisp hoàn toàn có thể làm được điều bạn yêu cầu.
1/- lấy tập hợp chọn bằng hàm ss như bạn đã làm.
2/- Duyệt qua các đối tượng để tạo một danh sách các phần tử kép gồm điểm đặt và ename của mỗi đối tượng
3/- Cùng hàm (vl-sort ....) để sắp xếp lại danh sách trên theo trật tự mà bạn muốn (tham khảo thêm hàm lambda)
4/- Tạo dach sách mới chỉ có các ename theo trật tự đã phân loại.

Bạn hãy thử làm xem nhé. Khó đâu hỏi tiếp nhé...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#557 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 30 October 2010 - 09:00 PM

E đã thử theo bác và viết ra đc cái sắp xếp đc entname theo trục Y từ cao xuống thấp. Nhưng sao kết quả trả về lại bị in ra 2 lần vậy bác nhỉ.

(defun c:tt(/ i ltn name_textnguon diemdat dxf_tn)
(setq ltn '()
i 0)
(setq textnguon (ssget))
(while (< i (sslength textnguon))
(setq name_textnguon (ssname textnguon i) ; lay entname
dxf_tn (entget name_textnguon);lay dxf
diemdat (cadr (cdr (assoc 10 dxf_tn))); lay diem dat text
lst_entname_diemdat (list diemdat name_textnguon); tao list
)
(setq ltn (append ltn (list lst_entname_diemdat)))
(setq i (1+ i))
);while
;;;;;-------
(vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)
(princ ltn)
)


Em thấy cái hàm vl-sort nó ghi là bỏ những kq trùng nhau mà.
  • 0

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


#558 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 30 October 2010 - 09:10 PM

E đã thử theo bác và viết ra đc cái sắp xếp đc entname theo trục Y từ cao xuống thấp. Nhưng sao kết quả trả về lại bị in ra 2 lần vậy bác nhỉ.

(defun c:tt(/ i ltn name_textnguon diemdat dxf_tn)
(setq ltn '()
i 0)
(setq textnguon (ssget))
(while (< i (sslength textnguon))
(setq name_textnguon (ssname textnguon i) ; lay entname
dxf_tn (entget name_textnguon);lay dxf
diemdat (cadr (cdr (assoc 10 dxf_tn))); lay diem dat text
lst_entname_diemdat (list diemdat name_textnguon); tao list
)
(setq ltn (append ltn (list lst_entname_diemdat)))
(setq i (1+ i))
);while
;;;;;-------
(vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)
(princ ltn)
)


Em thấy cái hàm vl-sort nó ghi là bỏ những kq trùng nhau mà.

Hề hề hề,
Chào bạn nguyentuyen6,
Nó in chỉ có một lần , còn lần thứ hai là do khi bạn thoát khỏi chương trình lisp Cad tự in ra giá trị cuối cùng của lisp. Cái này là do Cad nó mặc định như vậy. Để tránh trường hợp này, bạn cho thêm hàm princ vào cuối chương trình.
Nó bỏ các giá trị trùng nhau là vì bạn sử dụng hàm so sánh nhỏ hơn. Nếu bạn dùng hàm so sánh là nhỏ hơn và bằng thì nó không loại các giá trị trùng nhau.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#559 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 30 October 2010 - 09:53 PM

Hì. E xin đính chính lại là sắp theo trục y từ thấp đến cao. Nhưng lại có 1 vấn đề ở hàm lambda.

Ở trên là em dùng nó với 2 đối số. với chọn 2 text thì cho kq đúng. nhưng chọn nhiều hơn sẽ ra sai. Như trên là hàm lambda nó xét theo từng cặp phải ko ạ. và cách giải quyết để cái list dùng hàm vl-sort sẽ cho ra kết quả sắp xếp từ thấp đến cao????( với list nhiều hơn 2)
  • 0

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


#560 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2010 - 10:07 PM

Hì. E xin đính chính lại là sắp theo trục y từ thấp đến cao. Nhưng lại có 1 vấn đề ở hàm lambda.

Ở trên là em dùng nó với 2 đối số. với chọn 2 text thì cho kq đúng. nhưng chọn nhiều hơn sẽ ra sai. Như trên là hàm lambda nó xét theo từng cặp phải ko ạ. và cách giải quyết để cái list dùng hàm vl-sort sẽ cho ra kết quả sắp xếp từ thấp đến cao????( với list nhiều hơn 2)

Đổ oan cho hàm lambda tội lắm.
Lý do :
Thay dòng :
(vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)

Thanh dòng :
(setq ltn (vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)
)
  • 1