Chuyển đến nội dung
Diễn đàn CADViet
loprjnce

[XIN LISP] Quét, lọc và thay đổi Layer cho nhóm đối tượng.

Bởi loprjnce , trong AutoLisp

Các bài được khuyến nghị

loprjnce    0

loprjnce
Đã đăng

Chào ae CadViet,

Mình mới tìm hiểu về Lisp, AE cho mình hỏi nhờ viết dùm cái Lisp "Quét 1 nhóm đối tượng (dim, block, line,...) > enter > chương trình sẽ tự động lọc ra những đối tượng thuộc cùng 1 layer (mình định là layer nào trong code) > rùi chuyển những đối tượng vừa lọc được vào 1 layer khác (hoặc dùng lệnh .change để gán các thuộc tính khác) > sau đó tương tự làm lại cho layer tiếp theo.

Vd: các dt thuộc layer:

1 => 1a

2 => 2a

...

 

Chân thành cảm ơn Ae giúp đỡ. Thanks all...

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

quansla    259

quansla
Đã đăng
(progn

Nếu chỉ để học lisp có thể tham khảo dạng Code sau

  1. (progn
      (setq Lay_nguon "0" Lay_dich "Defpoints")
      (setq ss (ssget (list(cons 8 Lay_nguon))))
      (if (and Lay_nguon Lay_dich ss)
        ;(vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
        ;(command "change" ss "" "p" "la" Lay_dich "")
        (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))
      (princ "chuc ban thanh cong")
      (princ)
      )
  2. (setq Lay_nguon "0" Lay_dich "Defpoints") có chức năng Ấn định tên Layer Layer nguồn và layer Đích
  3. (setq ss (ssget (list(cons 8 Lay_nguon)))) cho phép chọn nhiều đối tượng cùng có chung Layer là Lay_nguon gán cho tập ss
  4. (if (and Lay_nguon Lay_dich ss)
        ;(vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
        ;(command "change" ss "" "p" "la" Lay_dich "")
        (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))                              Nếu có đồng thời đủ 3 đk, có khai báo Lay_nguon,Lay_dich, và có quét chọn đối tượng (ss khác nil) thì thực hiện 1 công việc sau If (bạn có thể thử cả 3 cách mà m đặt sau if (tác dụng thì như nhau.
    1. (vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
    2. (command "change" ss "" "p" "la" Lay_dich "")
    3. (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))

    Chúc bạn thành công

(progn
  (setq Lay_nguon "tuong" Lay_dich "Defpoints")
  (setq ss (ssget (list(cons 8 Lay_nguon))))
  (if (and Lay_nguon Lay_dich ss)
    ;(vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
    ;(command "change" ss "" "p" "la" Lay_dich "")
    (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))
  (princ "chuc ban thanh cong")
  (princ)
 
  (setq Lay_nguon "tuong" Lay_dich "Defpoints")
  (setq ss (ssget (list(cons 8 Lay_nguon))))
  (if (and Lay_nguon Lay_dich ss)
    ;(vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
    ;(command "change" ss "" "p" "la" Lay_dich "")
    (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))
  (princ "chuc ban thanh cong")
  (princ)
  )
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

quansla    259

quansla
Đã đăng

Bạn cũng nên thử bỏ lần lượt hai dòng (princ) sau đó (princ "chúc bạn thành công") rồi bỏ cả 2 dòng cùng lúc sau đó mới Copy vào cad xem sao, có kết quả gì, Nhận ra được không,

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Bạn cũng nên thử bỏ lần lượt hai dòng (princ) sau đó (princ "chúc bạn thành công") rồi bỏ cả 2 dòng cùng lúc sau đó mới Copy vào cad xem sao, có kết quả gì, Nhận ra được không,

 

Cám ơn bác quansla nhiều, để mình ráp tét thữ đoạn code này nha. Nếu có trục trặc gì cho mình hỏi thêm nha. Thanks nhiều

 

@Doan Van Ha: Mình biết dùng nhóm lệnh đó. CÓ điều là với những thao tác đó cứ lặp đi lặp lại, rất mất time nên mới tính ra Lisp.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Mình có chỉnh đoạn code lại theo layer của mình như sau:

(defun c:doily()
(progn
  (setq Lay_nguon "1" Lay_dich "1a")
  (setq ss (ssget (list(cons 8 Lay_nguon))))
  (if (and Lay_nguon Lay_dich ss)
    (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))
  (princ "chuc ban thanh cong")
  (princ)
  )
(setq Lay_nguon "1" Lay_dich "1a")
(setq ss (ssget (list(cons 8 Lay_nguon))))
(if (and Lay_nguon Lay_dich ss)
    (setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent))))
(vl-cmdf  "change" ss "" "p" "la" Lay_dich "")
(command "change" ss "" "p" "la" Lay_dich "")
(setq i -1)(while (< (setq i (1+ i)) (sslength ss)) (entmod(subst (cons 8 Lay_dich) (assoc 8 (setq ent (entget (ssname ss i)))) ent)))))

nhưng vấn đề là:

- Khi load active hiện lỗi "; error: extra right paren on input" (mình cũng không rõ lỗi gì)

- Khi command "doily" > quét vùng đối tượng > cad lọc quét chọn những đối tượng như layer mình muốn > "space" > chuc ban thanh cong > "space". Thế là hết lệnh! Nó không tự chuyển từ Lay_nguon sang Lay_dich như mình đã gán.

 

Mong AE hướng dẫn dùm. THanks all...

 

 

; error: extra right paren on input
 
; error: extra right paren on input

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Mình cũng có tham khảo và code như sau:

;Doi layer LkUp thanh LkDn
(defun c:chon()
  (princ "\n Change Layer")
  (sssetfirst nil (ssget '((8 . "1"))))
  (setq sset (ssget))
(command "_.change" sset " " "P" "LA" "1a" " ")
(princ)
  );The End.

Mình muốn là: thực hiện lệnh > quét chọn > " " ... thì lisp sẽ giúp mình phân loại những đt thuộc layer đã định trước chuyển lần lượt sang những layer đích đã định trước.

- Nhưng code trên mình quét và lisp nhận được đt thuộc Layer "1" > " " ... thì bị lỗi sau:

 

Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found

Select objects:  2 found


*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled

Select objects:  Specify change point or [Properties]:
No changeable object selected

Mong AE giải giúp dùm mình. THanks nhiều.

Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected
Select objects: Specify opposite corner: 2 found
 
Select objects:  2 found
 
 
*Invalid selection*
Expects a point or 
Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P
revious/Undo/AUto/SIngle
; error: Function cancelled
 
Select objects:  Specify change point or [Properties]:
No changeable object selected

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.984

ketxu
Đã đăng

Quick code cho bạn 

(defun c:doi(/ lstSource ss i e)
	(setq 	lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
			ss (ssget 
			(list (cons 8
				(substr
					(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
					2
				))
			))
			i -1
	)
	(while (setq e (ssname ss (setq i (1+ i))))
		(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
	)
	(princ)
)

 

(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
 
(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
)
(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
)
(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
 
(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
 
(defun c:doi(/ lstSource ss i e)
(setq lstSource '(("1" . "1a")("2" . "2a") ("3" . "3a")) ;Them danh sach nguon, dich vao day
ss (ssget 
(list (cons 8
(substr
(apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource)))
2
))
))
i -1
)
(while (setq e (ssname ss (setq i (1+ i))))
(entmod (append (setq e (entget e))(list (cons 8 (cdr (assoc (cdr (assoc 8 e)) lstSource))))))
)
(princ)
)
  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Cảm ơn tất cả mọi người mình sẽ test thữ code rùi review lại nha.

Ps: hok thấy nút thank ở đâu hết....

 

@Ket: Mong a Ket giải thích chi tiết dùm các cú pháp lệnh trong code của a đc hok? nếu được mình cảm ơn hết lời.... ^^ ( tại đang tự mày mò, nên ko có cơ sở đế hiểu rõ các lệnh ssget, while..., đã đọc các tìa liệu Autolisp trên Ggle mà thấy giải thích ít quá, ko ví dụ nữa. Nên khó nắm bắt đc hết lệnh.) thanks a Ketxu nhiều.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ketxu    2.984

ketxu
Đã đăng

Mình mô tả ngắn gọn nhé :

- Hàm ssget : dùng để quét chọn các đối tượng thỏa mãn bộ lọc filter, trả về tập chọn

   + Cú pháp : (ssget [option] filter) trong đó option là tùy chọn (tham khảo trong help, có hoặc không đều được), filter là list những thuộc tính cần lọc theo mã dxf

 

- Hàm substr : dùng để lấy 1 phần của chuỗi từ vị trí thứ i trở đi

   + Cú pháp (substr string i [len]) 

                  * string : chuỗi cần tách

                  * i : vị trí (chữ cái đầu tiên i = 0)

                  * len : chiều dài chuỗi cần lấy ra

 

- Hàm strcat : nối chuỗi

 

- Hàm list : tạo danh sách 

  + Cú pháp (list item1 item2 item3 ...)

 

- Hàm cons : tạo 1 list gồm có 2 phần tử

  + Cú pháp (cons item1 item2)

 

- Hàm car : lấy phần tử đầu tiên trong list

 + Cú pháp (car list)

 

- Hàm mapcar : hàm thực hiện 1 hàm lần lượt lên các phần tử trong list

 + Cú pháp (mapcar 'funtion list1 list2 ...)

       * funtion : là tên hàm, có thể định nghĩa bằng hàm lambda nếu không muốn đặt tên cho hàm

       * list1 list2 ... là các list phần tử tương ứng cần thực hiện. Số lượng list = số đối số hàm funtion

        VD : (mapcar '+ '(1 2 3) '(4 5 6)) = ((+ 1 4)(+ 2 5)(+ 3 6)) = (5 7 9)

 

- Hàm lambda : y như defun, nhưng không đặt tên, và là hàm cục bộ

 

- Hàm apply : hàm thực hiện 1 hàm lên toàn bộ phần tử trong list, coi các phần tử là đối số

  + Cú pháp : (apply 'funtion list)

      * Funtion L tương tự mapcar

      * list : danh sách đối số

     => Khác với mapcar, chú ý

  VD : (apply '+ '(1 2 3))   = (+ 1 2 3) = 6

 

 

=> Đoạn đầu (ssget (list (cons 8 (substr (apply 'strcat (mapcar '(lambda(x)(strcat "," x))(mapcar 'car lstSource))))) có nghĩa là chọn các đối tượng có layer đã được liệt kê trong phần tử đầu tiên của list các assoiative list ở đầu lisp.

 

Bạn hãy thử chạy từng cặp dấu ngoặc để tưởng tượng kết quả

 

 

 

- Hàm ssname : lấy name của đối tượng trong tập chọn (ename)

  + Cú pháp : (ssname ss i) : ss là tập chọn, i là thứ tự của đối tượng cần lấy (theo cách chọn). Đối tượng đầu tiên i = 0

 

- Hàm entget : lấy thông tin dxf mức 1 của đối tượng

    + Cú pháp (entget ename) : ename là entity name : tên của đối tượng, lấy bằng hàm (car (entsel)) hoặc ssname trong tập chọn

 

- Hàm assoc : lấy list 2 phần tử associative có trong list lớn (đặc biệt list tạo bởi hàm cons)

 

- Hàm entmod : entity modify, là hàm hiệu chỉnh đối tượng bằng mã dxf

  + Cú pháp (entmod dxf_lst) 

 

- Hàm append : hàm nối list

 + Cú pháp : (append list1 list2)

 

- Hàm while : vòng lặp có điều kiện

 + Cú pháp (while điều_kiện Biểu_thức_1 Biểu_thức_2 ... Biểu_thức_n)

 => Khi điều kiện còn khác nil thì thực hiện biểu thức 1, biểu thức 2 ... biểu thức n, sau đó quay lại kiểm tra điều kiện. Nếu vẫn khác nil thì lại thực hiện BT1, BT2...BTn rồi lại quay lại kiểm tra điều kiện

 

 

=> Đoạn sau có nghĩa là khi nào còn ssname (tức là duyệt từng phần tử trong ssget ở đoạn đầu) thì entmod layer của nó thành layer tương ứng đã được liệt kê ở istSource ban đầu.

 

 

p/s : chậm chậm thôi bạn nhé ^^

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Mình nghĩ bạn nên nghiên cứu lệnh ssx của express tools

Mình có xem lệnh ssx của Express tool rùi, nó chỉ giúp chúng ta lọc những đối tượng Similar Selection ( thuộc tính giống nhau) thôi. Nếu lệnh chỉ làm được thế thì mình dùng Quick Select sẽ nhanh hơn nhiều. (tại mình chỉ cần lọc theo Layer). Cái quan trọng ở đây là quá trình mình lọc Layer nguồn và chuyển nó thành Layer đích sẽ lặp đi lặp lại cho khoảng 10 cặp Layer. --> Lisp sẽ giúp mình tự động hoá quá trình đó.

Cảm ơn @hochoaivandot.

Thân.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

Alt+t+k = qselect

Nếu dùng Alt+t+k thì mình đổi lệnh thành QS xài nhanh hơn. Nhưng như đã nói ở trên là nhu cầu cần tự động hoá quá trình lọc và đổi Layer của mình. (khoảng 10 cặp layer trở lên) mà lặp đi lặp lại nhiều bản vẽ... THanks bạn đã quan tâm ^^

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

loprjnce    0

loprjnce
Đã đăng

@ketxu:

Thật sự thanks a Ketxu nhiều lắm. Quick Code của a đã giúp đúng nhu cầu của e rùi. Không hề lỗi gì cả ^^ ...

Và 1 lần nữa thanks a đã giải thích rõ các lệnh trong COde dùm e. E sẽ ngẫm kĩ từng lệnh để nắm bắt nguyên lý chung của lệnh. Có gì không rõ cho e hỏi thêm nha. ^^

 

THanks @Ketxu so much... (hjhj đọc huớng dẫn rùi mà thấy có nhiều lệnh chưa hiểu quá, chắc phải tốn time để ngâm lắm đây ^^)

 

P/S: Các bạn nào có cùng nhu cầu với mình thì nên ngâm Quick Code của @Ketxu nha. CHuẫn rùi đó ^^

- Mà em search "ssget" trong Help không thấy có kết quả? Hay là phần Help bị thiếu nhỉ? Nếu có mục nào chỉ dẫn tất cả các lệnh của Lisp trong Help thì chỉ e đường dẫn với nha. THanks

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×