Nhờ các cao thủ viết hộ Lisp copy với nội dung bên dưới

[hoangtdh 8]

Gửi các anh, chị trong diễn đàn

Em mới tham gia diễn đàn mong nhờ các cao thủ chỉ giáo. Em hay làm bản vẽ và thường phải copy 1 đối tượng gốc thành nhiều đối tượng (ví dụ n)với 1 khoảng cách cho trước (Ví dụ a) theo trục x hoặc y. Cách thông thường là dùng lệnh array nhập số hàng, số cột, khoảng cách nhưng cách này rất bất tiện và mất thời gian khi số hàng =1 hoặc số cột =1. Vì vậy em muốn có 1 lisp dùng như lệnh copy chỉ cần nhập số lượng copy và khoảng cách giữa các đối tượng là ra kết quả. Ngoài ra nếu được thì viết lisp với nội dung tương tự nhưng với lệnh DIM đề tạo nhiều đoạn kích thước bằng nhau cùng một lúc.

Xin cám ơn các anh, chị trước.

Em Hoàng.

[Doan Van Ha 3.196]

Gửi các anh, chị trong diễn đàn

Em mới tham gia diễn đàn mong nhờ các cao thủ chỉ giáo. Em hay làm bản vẽ và thường phải copy 1 đối tượng gốc thành nhiều đối tượng (ví dụ n)với 1 khoảng cách cho trước (Ví dụ a) theo trục x hoặc y. Cách thông thường là dùng lệnh array nhập số hàng, số cột, khoảng cách nhưng cách này rất bất tiện và mất thời gian khi số hàng =1 hoặc số cột =1. Vì vậy em muốn có 1 lisp dùng như lệnh copy chỉ cần nhập số lượng copy và khoảng cách giữa các đối tượng là ra kết quả. Ngoài ra nếu được thì viết lisp với nội dung tương tự nhưng với lệnh DIM đề tạo nhiều đoạn kích thước bằng nhau cùng một lúc.

Xin cám ơn các anh, chị trước.

Em Hoàng.

Dùng cái này của CADViet được không?

;; free lisp from cadviet.com

 

(defun c:ac (/ dt p1 p2 sl index kc goc)

(setq dt (ssget)

p1 (getpoint "\nVao diem goc: ")

p2 (getpoint p1 "\nVao diem den: ")

sl (getint "\nVao so lan: ")

goc (angle p1 p2)

kc (distance p1 p2)

index 0

)

(repeat sl

(setq index (1+ index))

(command ".copy" dt "" p1 (polar p1 goc (* kc index)))

)

)

[hoangtdh 8]

Gửi bạn Hà,

Cám ơn bạn Hà rất nhiều. Mình đã test thử rất tốt nhưng bạn chỉnh sửa code để giảm số luợng vật thể copy đi 1. ví dụ nhập số lần= 4 thì chỉ có 3 đối tượng copy + vật thể gốc là 4 (tương tự lệnh array). Ngoài ra bạn viết hộ mình nội dung tương tự đối với lệnh DIM để tránh phải dùng lệnh dco liên tục để bắt điểm cho các vật thể này sau khi dùng lệnh ac của bạn.

Thanks

[Doan Van Ha 3.196]

Gửi bạn Hà,

Cám ơn bạn Hà rất nhiều. Mình đã test thử rất tốt nhưng bạn chỉnh sửa code để giảm số luợng vật thể copy đi 1. ví dụ nhập số lần= 4 thì chỉ có 3 đối tượng copy + vật thể gốc là 4 (tương tự lệnh array). Ngoài ra bạn viết hộ mình nội dung tương tự đối với lệnh DIM để tránh phải dùng lệnh dco liên tục để bắt điểm cho các vật thể này sau khi dùng lệnh ac của bạn.

Thanks

Sửa dòng

sl (getint "\nVao so lan: ")

Thành dòng

sl (- (getint "\nVao so lan: ") 1)

-----

;; free lisp from cadviet.com

(defun c:ac (/ dt p1 p2 sl index kc goc)

(setq dt (ssget)

p1 (getpoint "\nVao diem goc: ")

p2 (getpoint p1 "\nVao diem den: ")

sl (- (getint "\nVao so lan: ") 1)

goc (angle p1 p2)

kc (distance p1 p2)

index 0

)

(repeat sl

(setq index (1+ index))

(command ".copy" dt "" p1 (polar p1 goc (* kc index)))

)

)

(defun c:ad (/ p1 p2 sl index kc goc)

(setq p1 (getpoint "\nVao diem goc: ")

p2 (getpoint p1 "\nVao diem den: ")

sl (- (getint "\nVao so lan: ") 1)

goc (angle p1 p2)

kc (distance p1 p2)

index 0

)

(repeat sl

(setq index (1+ index))

(command ".dim" "ali" p1 (polar p1 goc kc) p1 "" "e")

(setq p1 (polar p1 goc kc))

)

)

[master_worse 88]

Gửi các anh, chị trong diễn đàn

Em mới tham gia diễn đàn mong nhờ các cao thủ chỉ giáo. Em hay làm bản vẽ và thường phải copy 1 đối tượng gốc thành nhiều đối tượng (ví dụ n)với 1 khoảng cách cho trước (Ví dụ a) theo trục x hoặc y. Cách thông thường là dùng lệnh array nhập số hàng, số cột, khoảng cách nhưng cách này rất bất tiện và mất thời gian khi số hàng =1 hoặc số cột =1. Vì vậy em muốn có 1 lisp dùng như lệnh copy chỉ cần nhập số lượng copy và khoảng cách giữa các đối tượng là ra kết quả. Ngoài ra nếu được thì viết lisp với nội dung tương tự nhưng với lệnh DIM đề tạo nhiều đoạn kích thước bằng nhau cùng một lúc.

Xin cám ơn các anh, chị trước.

Em Hoàng.

Nếu cad của bạn có Express bạn có thể tham khảo lệnh COPYM

[hoangtdh 8]

Gửi Bạn Hà.

Lisp rất tuyệt.Thanks

Ý kiến của bạn master_wrose dùng copym cũng làm được nhưng phải làm nhiều thao tác hơn sử dụng lisp.

Hoàng

[hoangtdh 8]

Gửi Bạn Hà,

Sau khi sử dụg lệnh ad của bạn để bắt kích thước, tôi ko sủ dụng dim đã tạo ra để phối hợp được với lệnh cd (cắt đường dóng) và bd (move vị trí đặt text) của Cut dim.lsp như khi dùng lệnh dli và dco của cad để bắt vật thể.

Bạn có thể giải quyết được vấn đề trên không.

Hoàng

[ketxu 2.984]

@Hoang: Nếu bạn thích cơ sở là lệnh array thì mình viết lại lệnh ad giúp bạn đây, dựa trên lệnh -array và bỏ vòng lặp đi, góc xoay có thể là bất kỳ,k nhất thiết là theo trục x hay y, dùng cắt dim thoải mái.Lệnh Ac ban đầu cũng có thể viết lại theo cách này :)

;free lisp from cadviet.com @ ketxu
(defun c:ad (/ dimObj 1st 2nd )
(command "_dimaligned")
(while (< 0 (getvar "CMDACTIVE"))(command pause))
(setq dimObj (entget(entlast))
	1st (cdr (assoc 13 dimObj))
	2nd (cdr (assoc 14 dimObj))		
	oSang (getvar "snapang"))
(setvar "snapang" (angle 1st 2nd))
(command "-array" (entlast) "" "R" 1 (getint "\n So lan array : ") 1st 2nd)
(setvar "snapang" oSang)
)

@Hoàng : bạn nên ấn Thanks bạn Hà thay vì chỉ " nói suông " ^^ Hề hề.Cả mình nữa nếu useful keke

[hoangtdh 8]

Gửi bạn Hà và ketxu,

Thành thật xin lỗi 2 bạn, mình mới tham gia diễn đàn nên chưa quen sử dụng,có gì các bạn bỏ qua.

Lisp của bạn ketxu cũng rất hay. Mình có thêm mong muốn là ở lệnh ac và ad thì tự động chọn điểm đầu là base point của block đuợc chọn copy (vì mình dùng chủ yếu với các block) với mục đích giảm thao tác và đỡ chọn nhầm.

Ngoài ra nếu có thể thì mình muốn có 1 lisp dùng để lock/unlock layer khi chọn bất kỳ đối tuợng nào thuộc lớp đó.

Thành thật cám ơn vì sự giúp đỡ nhiệt tình của các bạn.

Hoàng

[phamngoctukts 714]

Gửi bạn Hà và ketxu,

Thành thật xin lỗi 2 bạn, mình mới tham gia diễn đàn nên chưa quen sử dụng,có gì các bạn bỏ qua.

Lisp của bạn ketxu cũng rất hay. Mình có thêm mong muốn là ở lệnh ac và ad thì tự động chọn điểm đầu là base point của block đuợc chọn copy (vì mình dùng chủ yếu với các block) với mục đích giảm thao tác và đỡ chọn nhầm.

Ngoài ra nếu có thể thì mình muốn có 1 lisp dùng để lock/unlock layer khi chọn bất kỳ đối tuợng nào thuộc lớp đó.

Thành thật cám ơn vì sự giúp đỡ nhiệt tình của các bạn.

Hoàng

bạn dùng thử cái này mình sửa giúp bạn rồi và thêm lệnh khoa và mokhoa layer.

(defun c:ad (/ dimObj 1st 2nd )
(command "_dimaligned")
(while (< 0 (getvar "CMDACTIVE"))(command pause))
(setq dimObj (entget(entlast))
	1st (cdr (assoc 13 dimObj))
	2nd (cdr (assoc 14 dimObj))		
	oSang (getvar "snapang"))
(setvar "snapang" (angle 1st 2nd))
(command "-array" (entlast) "" "R" 1 (getint "\n So lan array : ") 1st 2nd)
(setvar "snapang" oSang)
)

(defun c:ac (/ dt p1 p2 sl index kc goc)
 (setq	dt    (car (entsel "n\chon block"))
p1    (cdr (assoc 10 (entget dt)))
p2    (getpoint p1 "\nVao diem den: ")
sl    (- (getint "\nVao so lan: ") 1)
goc   (angle p1 p2)
kc    (distance p1 p2)
index 0
 )
 (repeat sl
   (setq index (1+ index))
   (command ".copy" dt "" p1 (polar p1 goc (* kc index)))
 )
)
(defun c:khoa (/ dt la)
 (setq	dt    (car (entsel "n\chon doi tuong can khoa layer: "))
la    (cdr (assoc 8 (entget dt)))
)
 (command "layer" "lo" la "")
 )
(defun c:mokhoa (/ dt la)
 (setq	dt    (car (entsel "n\chon doi tuong can khoa layer: "))
la    (cdr (assoc 8 (entget dt)))
)
 (command "layer" "u" la "")
 )

[hoangtdh 8]

Gửi bạn Tú,

Lisp của bạn rất tuyệt, tuy nhiên nếu bạn có thể nhập khoa/mo khoa thành 1 từ khoa ko thôi thì tuyệt hơn nữa.ví dụ: layer đang ko lock sẽ tự động lock, layer đang bị lock sẽ unlock khi chọn đối tuợng thì đỡ phải gõ thêm lệnh.

Hoàng

[phamngoctukts 714]

Gửi bạn Tú,

Lisp của bạn rất tuyệt, tuy nhiên nếu bạn có thể nhập khoa/mo khoa thành 1 từ khoa ko thôi thì tuyệt hơn nữa.ví dụ: layer đang ko lock sẽ tự động lock, layer đang bị lock sẽ unlock khi chọn đối tuợng thì đỡ phải gõ thêm lệnh.

Hoàng

Của bạ đây

(defun c:khoa (/ dt la)
 (setq	dt    (car (entsel "n\chon doi tuong can khoa layer: "))
la    (cdr (assoc 8 (entget dt)))
)
 (if (= (cdr (assoc 70 (tblsearch "layer" la))) 4)
   (command "layer" "u" la "")
   (command "layer" "lo" la "")
 )
 )

[hoangtdh 8]

Gửi bạn Tú,

Cám ơn bạn rất nhiều. Có thể tôi hơi tham lam nhưng bạn có thể viết thêm lisp khi chọn đối tuợng thì layer của đối tuợng đó thành layer hiện hành được không. LISP này sẽ giúp tôi rất nhiều trong các bản vẽ đi dây cho thiết bị.

Hoàng

[phamngoctukts 714]

Gửi bạn Tú,

Cám ơn bạn rất nhiều. Có thể tôi hơi tham lam nhưng bạn có thể viết thêm lisp khi chọn đối tuợng thì layer của đối tuợng đó thành layer hiện hành được không. LISP này sẽ giúp tôi rất nhiều trong các bản vẽ đi dây cho thiết bị.

Hoàng

Quá dễ. Của bạn đây

(defun c:cl (/ dt la)
 (setq	dt    (car (entsel "n\chon doi tuong lay layer hien hanh: "))
la    (cdr (assoc 8 (entget dt)))
)
 (setvar "clayer" la)
 )

[ketxu 2.984]

Gửi bạn Hà và ketxu,

Thành thật xin lỗi 2 bạn, mình mới tham gia diễn đàn nên chưa quen sử dụng,có gì các bạn bỏ qua.

Lisp của bạn ketxu cũng rất hay. Mình có thêm mong muốn là ở lệnh ac và ad thì tự động chọn điểm đầu là base point của block đuợc chọn copy (vì mình dùng chủ yếu với các block) với mục đích giảm thao tác và đỡ chọn nhầm.

Ngoài ra nếu có thể thì mình muốn có 1 lisp dùng để lock/unlock layer khi chọn bất kỳ đối tuợng nào thuộc lớp đó.

Thành thật cám ơn vì sự giúp đỡ nhiệt tình của các bạn.

Hoàng

Chào bạn.Mình đi mãi đến giờ mới về đọc được rl của bạn.Các yêu cầu của bạn bác Tú đáp ứng hết rồi, mình xin góp thêm 1 tí phần ac để bạn có thể thao tác với nhiều block 1 lúc, vẫn với hướng theo lệnh array, chúc bạn thành công :

 

 

(defun c:ab (/ ss 1st 2nd sl ent oSang)
(setq 	ss (ssget '((0 . "INSERT")))
	1st (cdr (assoc 10 (entget(ssname ss 0))))
	2nd (getpoint 1st "\n Phuong va khoang cach :")
	sl (getint "\n So lan array : ")
	oSang (getvar "snapang"))
(setvar "snapang" (angle 1st 2nd))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(command "-array" ent "" "R" 1 sl 1st 2nd)
)
(setvar "snapang" oSang)
)

P/s : lisp cuối bạn yêu cầu chính là lệnh _laymcur ^^

[hoangtdh 8]

Gửi bạn Tú và Ketxu,

Cám ơn 2 bạn nhiều. Tiếc quá mình hết mất quyền vote rồi ko thì cũng vote cho 2 bạn. công nhận là có lisp làm bản vẽ nhanh hơn rất nhiều.

Chúc 2 bạn thành công và đóng góp nhiều hơn nữa cho diễn đàn.

Hoàng

[hoangtdh 8]

Gửi bạn Tú và ketxu,

Các bạn có thể viết thêm code cho mình theo yêu cầu sau được không.

- Khi chọn 1 hoặc nhiều đối tượng thì các đối tượng đó tự động thuộc layer hiện hành.

Hoàng

[nguyentuyen6 130]

Gửi bạn Tú và ketxu,

Các bạn có thể viết thêm code cho mình theo yêu cầu sau được không.

- Khi chọn 1 hoặc nhiều đối tượng thì các đối tượng đó tự động thuộc layer hiện hành.

Hoàng

 

Bạn thử cái này nhé

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
				;nguyentuyen6 @ Cadviet
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget))
;;;;;;;;
   (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
(if (/= (cdr (assoc 8 (entget en))) curla)
          (moddxf 8 curla en)
        )
(if	(= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
          (moddxf 8 curla en)
          (upwblock en)
	)
)
   (entupd en)
   (setq i (1+ i))
 )					; (command ".REGEN")  
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
          (moddxf 8 curla en)
        )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[nguyentienthanhddksct 6]

Gửi bạn Tú và ketxu,

Các bạn có thể viết thêm code cho mình theo yêu cầu sau được không.

- Khi chọn 1 hoặc nhiều đối tượng thì các đối tượng đó tự động thuộc layer hiện hành.

Hoàng

 

 

cái này dùng lệnh MA là được thui mà.

[hoangtdh 8]

Gửi bạn Nguyentuyen6,

Lisp của bạn tương đối ổn nhưng khi áp dụng với block thì gặp vấn đề sau:

- Layer ngoài của block thuộc lớp hiện hành nhưng layer trong vẫn ko đổi. Mình muốn cả layer trong và ngoài đều đổi thì sẽ tiện hơn khi format lại đối tượng.

Cám ơn bạn nhiều.

Hoàng

[phamngoctukts 714]

Gửi bạn Nguyentuyen6,

Lisp của bạn tương đối ổn nhưng khi áp dụng với block thì gặp vấn đề sau:

- Layer ngoài của block thuộc lớp hiện hành nhưng layer trong vẫn ko đổi. Mình muốn cả layer trong và ngoài đều đổi thì sẽ tiện hơn khi format lại đối tượng.

Cám ơn bạn nhiều.

Hoàng

Nhắc nhở bạn không nên port nhiều câu hỏi trùng nhau trên diễn đàn. Bạn lập nhiều topic và hỏi những vấn đề đã được giải quyết từ lâu trên diễn đàn. Bạn hãy search trước khi đặt câu hỏi bạn nhé.

[hoangtdh 8]

Gửi Tú,

Ok. Mình sẽ rút kinh nghiệm cho các lần hỏi sau.

Hoàng

[nguyentuyen6 130]

Gửi bạn Nguyentuyen6,

Lisp của bạn tương đối ổn nhưng khi áp dụng với block thì gặp vấn đề sau:

- Layer ngoài của block thuộc lớp hiện hành nhưng layer trong vẫn ko đổi. Mình muốn cả layer trong và ngoài đều đổi thì sẽ tiện hơn khi format lại đối tượng.

Cám ơn bạn nhiều.

Hoàng

Bạn dùng cái này nhé:

Bạn dùng từ "cao thủ" làm mọi người thấy "sợ" đấy

 

(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
;nguyentuyen6 @ Cadviet
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget ))
 (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
   (if	(/= (cdr (assoc 0 (entget en))) "INSERT")
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
     (upwblock en)
   )
   (entupd en)
   (setq i (1+ i))
 )
;  (command ".REGEN")
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)

[hoangtdh 8]

Gửi bạn Tuyến,

Do mình ko download được cl.lsp của bạn nên mình copy đoạn code và tạo ra cl.lsp nhưng khi chạy báo lỗi sau:

 

Command: ap

APPLOAD cl.lsp successfully loaded.

Command: cl

Unknown command "CL". Press F1 for help.

 

Mình post cl.lsp lên để bạn kiểm tra lại giúp mình:

http://www.cadviet.com/upfiles/3/cl.lsp

 

Hoàng

[nguyentuyen6 130]

Gửi bạn Tuyến,

Do mình ko download được cl.lsp của bạn nên mình copy đoạn code và tạo ra cl.lsp nhưng khi chạy báo lỗi sau:

 

Command: ap

APPLOAD cl.lsp successfully loaded.

Command: cl

Unknown command "CL". Press F1 for help.

 

Mình post cl.lsp lên để bạn kiểm tra lại giúp mình:

http://www.cadviet.com/upfiles/3/cl.lsp

 

Hoàng

http://www.cadviet.com/upfiles/3/cl_2.lsp

 

Bạn download cái này về nhé, hình như download của diễn đàn bị hỏng