Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
conghoa

Lệnh offset đặc biệt

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

Cảm ơn tác giả nhiều với lisp đơn giản nhưng khá hay!

 

Mục đính của lisp:

 

- Khi bổ chi tiết, bạn hay phải offset lớp vữa và màu của lớp vữa thường là khác với mầu tường. Bình thường khi sử dụng bạn phải offset nét tường đó ra 15 (chẳng hạn) rồi phải dùng tiếp lệnh ma để chuyển nó sang layer khác. Lisp này sẽ khắc phục những thao tác Ma nhàm chán đó.

 

- Lisp này sẽ offset và tự động đổi đối tượng mới sang lớp hiện hành.

 

- Tên lệnh : oo

 

(defun C:OO (/ lay lt os kc msg1 p1 msg2)
	(setq   os (getvar "Osmode")
 lt (getvar "celtype")
			lay (getvar "Clayer")
			msg1 "\nVao khoang cach offset: "
			kc (getreal msg1)
			msg2 (strcat "Chon vat the muon offset:*" (rtos kc) "*")
	);het setq
	(setvar "OSMODE" 512)
	(setq   p1 (getpoint msg2))
(while p1
(command "offset" kc p1 pause "" "chprop" "l" "" "la" lay "lt" lt "")
	(setq   p1 (getpoint msg2))
);het while
	(setvar "OSMODE" os)
)

 

 

 

@all Bạn nào có thể nâng cấp chương trình này không vậy, hiện tại mỗi lần dùng lệnh lại phải nhập lại kích thước offset, nó không lưu lại được kết quả nhập vào từ lần trước.

 

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

thử cái này đi. chắc bạn sẽ hài lòng...

(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
;	(princ ent)
;	(setq e5 nil)
;	(setq e5 (cdr (assoc 5 ent)))
;	(princ e5)
;	(if (= nil e5) (setq e5 ))

(setq la (list (cons 0 "LINE")
	(cons 5 (cdr (assoc 5 ent)) )
	(cons 8 (cdr (assoc 8 ent)) )
	(cons 10 p3)
	(cons 11 p4)
))
;	(princ la)
(entmake la)
(princ)
)

(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
	(if (			(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
	))
	(if (			(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
	))

))
(princ)
)

(if (not (= nil data_m)) (progn
	(setq i 0)
	(while (			(setq ent (entget (ssname data_m i)))
		(p_check)
		(if (= 1 check) (p_d_offset))
		(setq i (+ i 1))
	))
))
(princ)
)
(import_data)
  (ai_undo_push)
(process)
  (ai_undo_pop)
(princ)
)

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

Thanks jikibo Nhưng cái lisp của bạn có tính năng khác so với lisp của mình, nó chỉ offset đối tượng được chọn sang 2 bên thôi, còn cái mình post là nó offset đối tượng rồi chuyển layer của đối tượng mới sang lớp hiện hành mà :unsure:.

 

Lúc trước NguyenHoanh cũng có làm gíup mình 1 cái lisp tương tự cái của bạn nhưng cao cấp hơn 1 chút là nó tự động xoá cái đối tượng ban đầu, nhưng chẳng hiểu sao lúc dùng được lúc không :unsure:(

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
Cảm ơn tác giả nhiều với lisp đơn giản nhưng khá hay!

 

Mục đính của lisp:

 

- Khi bổ chi tiết, bạn hay phải offset lớp vữa và màu của lớp vữa thường là khác với mầu tường. Bình thường khi sử dụng bạn phải offset nét tường đó ra 15 (chẳng hạn) rồi phải dùng tiếp lệnh ma để chuyển nó sang layer khác. Lisp này sẽ khắc phục những thao tác Ma nhàm chán đó.

 

- Lisp này sẽ offset và tự động đổi đối tượng mới sang lớp hiện hành.

 

- Tên lệnh : oo

 

(defun C:OO (/ lay lt os kc msg1 p1 msg2)
	(setq   os (getvar "Osmode")
 lt (getvar "celtype")
			lay (getvar "Clayer")
			msg1 "\nVao khoang cach offset: "
			kc (getreal msg1)
			msg2 (strcat "Chon vat the muon offset:*" (rtos kc) "*")
	);het setq
	(setvar "OSMODE" 512)
	(setq   p1 (getpoint msg2))
(while p1
(command "offset" kc p1 pause "" "chprop" "l" "" "la" lay "lt" lt "")
	(setq   p1 (getpoint msg2))
);het while
	(setvar "OSMODE" os)
)

@all Bạn nào có thể nâng cấp chương trình này không vậy, hiện tại mỗi lần dùng lệnh lại phải nhập lại kích thước offset, nó không lưu lại được kết quả nhập vào từ lần trước.

 

Thanks!

Chương trình "mini" này chắc hợp ý bạn:

 

(defun C:OO(/ kc kc1 e msg)
(if (<= (setq kc (getvar "OFFSETDIST")) 0) (setq kc 20))
(setq msg (strcat "\nSpecial offset command\nOffset distance <" (rtos kc) ">:"))
(if (setq kc1 (getreal msg)) (setq kc kc1))
(while (setq e (car (entsel)))
(command "offset" kc e pause "")
(command "change" "L" "" "P" "LA" (getvar "clayer") "LT" (getvar "celtype") "")
)
)

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

Ơ cái này cad06,07 hỗ trợ rồi mà

 

Command: o OFFSET

Current settings: Erase source=No Layer=Source OFFSETGAPTYPE=0

Specify offset distance or [Through/Erase/Layer] : L

Enter layer option for offset objects [Current/Source] : C

  • Vote tăng 2

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
Ơ cái này cad06,07 hỗ trợ rồi mà

 

Command: o OFFSET

Current settings: Erase source=No Layer=Source OFFSETGAPTYPE=0

Specify offset distance or [Through/Erase/Layer] : L

Enter layer option for offset objects [Current/Source] : C

Cám ơn bemove, thật tình mình chưa biết tính năng này. Mặc dù trên máy mình có cài Cad2007 nhưng chỉ để nghiên cứu, và vẫn dùng Cad2002 cho công việc hàng ngày. Lý do: ở cơ quan làm việc theo nhóm trên mạng LAN, trong đó có rất nhiều máy đã hết khấu hao vẫn còn "cày". Nếu nâng cấp phần mềm, chúng nó chạy không nổi! Đành rằng, dùng cad đới sau có thể saveas theo đời trước, nhưng rất bất tiện và mất thời gian. Đành chấp nhận theo mặt bằng chung vậy.

Hơn nữa, theo xu thế hiện nay, chắc phải từ giã thói quen xài phần mềm "chùa" cho công việc. Không chừng R14 cũng không có mà dùng!

Vì những lý do trên, có lẽ lisp trên vẫn có giá trị sử dụ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
Cám ơn bemove, thật tình mình chưa biết tính năng này. Mặc dù trên máy mình có cài Cad2007 nhưng chỉ để nghiên cứu, và vẫn dùng Cad2002 cho công việc hàng ngày. Lý do: ở cơ quan làm việc theo nhóm trên mạng LAN, trong đó có rất nhiều máy đã hết khấu hao vẫn còn "cày". Nếu nâng cấp phần mềm, chúng nó chạy không nổi! Đành rằng, dùng cad đới sau có thể saveas theo đời trước, nhưng rất bất tiện và mất thời gian. Đành chấp nhận theo mặt bằng chung vậy.

Hơn nữa, theo xu thế hiện nay, chắc phải từ giã thói quen xài phần mềm "chùa" cho công việc. Không chừng R14 cũng không có mà dùng!

Vì những lý do trên, có lẽ lisp trên vẫn có giá trị sử dụng?

Mình xin góp ý thêm cách sử dụng lenh offset

OFFSET

Through/Erase/Layer Through [Exit/Multiple/Undo]

M offset tiếp tục mà ko phải chọn lại đối tượng cũ

E Thoát lệnh

U Undo đối tượng vừa offset

Erase Yes/No Y xoá đối tượng chọn ban đầu

N ko xoa doi tuong chon ban dau

Layer Current/Source

C đối tượng mới thuộc layer hiện hành

S đối tượng mới cùng layer với đối tượng cũ

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
Mình xin góp ý thêm cách sử dụng lenh offset

OFFSET

Through/Erase/Layer Through [Exit/Multiple/Undo]

M offset tiếp tục mà ko phải chọn lại đối tượng cũ

E Thoát lệnh

U Undo đối tượng vừa offset

Erase Yes/No Y xoá đối tượng chọn ban đầu

N ko xoa doi tuong chon ban dau

Layer Current/Source

C đối tượng mới thuộc layer hiện hành

S đối tượng mới cùng layer với đối tượng cũ

Toi cung xin bo sung them:

Doi voi tat ca cac cad thi co lenh "exoffset" cung tinh nang nhu tren

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

Trong lệnh xline bạn cũng có chức năng offset, khi đó đường line mới được offset cũng sẽ tự chuyển sang layer hiện hành. Tuy nhiên nó chỉ có tác dụng vơi các bản cad trước còn các bản cad từ 2006 thì làm theo bác bemove là tiện nhất.

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

lisp của jikibo chỉ là offset 1 lần thành nhiều đối tượng với cùng 1 khoảng cách, và về cùng 1 hướng, gần giống với lệnh array.

bác nào có thể giúp em cái lisp offset đối tượng sang 2 bên: ( gõ lệnh, nhập khoảng cách, chọn đối tượng là tự động có 2 đối tượng mới ở về 2 fía của đối tượng ban đầu).

tìm trên diễn đàn mà toàn lisp offset giống array quá. thanks các bác trước.

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
lisp của jikibo chỉ là offset 1 lần thành nhiều đối tượng với cùng 1 khoảng cách, và về cùng 1 hướng, gần giống với lệnh array.

bác nào có thể giúp em cái lisp offset đối tượng sang 2 bên: ( gõ lệnh, nhập khoảng cách, chọn đối tượng là tự động có 2 đối tượng mới ở về 2 fía của đối tượng ban đầu).

tìm trên diễn đàn mà toàn lisp offset giống array quá. thanks các bác trước.

Bạn sử dụng Lisp offset liên tục của Tue_NV nhé

Lisp offset liên tục - Bài viết số 10

  • 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
Bạn sử dụng Lisp offset liên tục của Tue_NV nhé

Lisp offset liên tục - Bài viết số 10

 

cũng giống nhau thôi bạn àh, chỉ là offset liên tuc, và về 1 fía.

ban đọc lại yêu cầu về lisp của mình thì sẽ hiểu yêu cầu.

(chỉ cần nhập khoảng cách cần offset và chọn đối tượng 1 lần)

 

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

sở dĩ mình đưa ra yêu cầu về lisp như vậy vì có rất nhiều trường hơp, khoảng offset sang 2 bên rất nhỏ, chỉ 1 vài mm. nên nếu zoom lên để chọn lại đối tượng (mặc dù không cần phải gõ lại lệnh và nhập lại khoảng cách) là rất mất thời gian.

 

mong nhận được sự giúp đỡ từ các bạ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
sở dĩ mình đưa ra yêu cầu về lisp như vậy vì có rất nhiều trường hơp, khoảng offset sang 2 bên rất nhỏ, chỉ 1 vài mm. nên nếu zoom lên để chọn lại đối tượng (mặc dù không cần phải gõ lại lệnh và nhập lại khoảng cách) là rất mất thời gian.

 

mong nhận được sự giúp đỡ từ các bạn.

Bạn tham khảo lisp này xem:

http://www.cadviet.com/upfiles/2/multioffset.lsp

  • 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

thanks bạn, đúng cái mình cần đây rồi :bigsmile: :bigsmile:

bạn có thể cho mình hỏi thêm cách bỏ đi các lựa chọn xóa đối tượng gốc và chọn layer thì phải xóa đi đoạn code nào??

 

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
thanks bạn, đúng cái mình cần đây rồi :bigsmile: :bigsmile:

bạn có thể cho mình hỏi thêm cách bỏ đi các lựa chọn xóa đối tượng gốc và chọn layer thì phải xóa đi đoạn code nào??

Thanks!

Chào hdg2318, đây là file multioffset, thiep chỉnh sửa lại để không còn hỏi lớp, và hỏi có xóa đối tượng gốc không:

http://www.cadviet.com/upfiles/2/multioffs...ong_hoi_lop.lsp

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
thử cái này đi. chắc bạn sẽ hài lòng...

(defun c:oo(/ data_m)

(defun import_data(/ i)
(setq data_m (ssget))
(if (= nil distan_m) (setq distan_m 110.0))
(princ "Distance (")
(princ distan_m)
(princ "):")
(setq i (getreal ))
(if (not (= nil i)) (setq distan_m i))
)

(defun process(/ ent check)

(defun p_check()
(setq check 0)
(if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))
(princ)
)

(defun p_d_offset(/ p1 p2 p3 p4)

(defun makeline(/ e2 e5)
;	(princ ent)
;	(setq e5 nil)
;	(setq e5 (cdr (assoc 5 ent)))
;	(princ e5)
;	(if (= nil e5) (setq e5 ))

(setq la (list (cons 0 "LINE")
	(cons 5 (cdr (assoc 5 ent)) )
	(cons 8 (cdr (assoc 8 ent)) )
	(cons 10 p3)
	(cons 11 p4)
))
;	(princ la)
(entmake la)
(princ)
)

(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )
(if (not (= p1 p2)) (progn
	(if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn
		(setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )
		(setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )
		(makeline)
	))
	(if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn
		(setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
		(setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )
		(setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )
		(makeline)
	))

))
(princ)
)

(if (not (= nil data_m)) (progn
	(setq i 0)
	(while (< i (sslength data_m)) (progn
		(setq ent (entget (ssname data_m i)))
		(p_check)
		(if (= 1 check) (p_d_offset))
		(setq i (+ i 1))
	))
))
(princ)
)
(import_data)
  (ai_undo_push)
(process)
  (ai_undo_pop)
(princ)
)

 

chỉ áp dụng được đường thẳng không áp cho đường xiên được thật là chưa vui hết đâ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

Nhân tiện đây xin hỏi mọi người luôn, mong được sự giúp đỡ

Mình cần lệnh offset đối tượng

- sang 2 phía

- đối tượng mới ở layer hiện hành

 

Giống lisp multioffset ở trên nhưng không hỏi nhiều như thế làm chậm quá trình vẽ

Đại loại là giống lisp của ssg, nhưng có điều là offset sang 2 bên

 

Chân thành cảm ơ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

Nhân tiện đây xin hỏi mọi người luôn, mong được sự giúp đỡ

Mình cần lệnh offset đối tượng

- sang 2 phía

- đối tượng mới ở layer hiện hành

 

Giống lisp multioffset ở trên nhưng không hỏi nhiều như thế làm chậm quá trình vẽ

Đại loại là giống lisp của ssg, nhưng có điều là offset sang 2 bên

 

Chân thành cảm ơn

Bạn dùng thử cái này

(defun c:o2p()
 (setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset: ")))
kc (* (getreal"\n Nhap khoang cach offset: ") 2)
sp (vlax-safearray->list(vlax-variant-value(vla-get-startpoint ob)))
ep (vlax-safearray->list(vlax-variant-value(vla-get-endpoint ob))))
 (command "Mline" "j" "z" "s" kc sp ep "")
 (command "explode" "l" "")
 )

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

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq dist (getdist "\nKhoang cach offset: "))
(princ "\nChon doi tuong offset ")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "Yes No")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong [Yes/No] : "))
(if (null kwrd)
(setq kwrd "No")
)
(foreach obj objlst
(vla-offset obj dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "Yes")
(vla-erase obj)
)
)
)
)
(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

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq dist (getdist "\nKhoang cach offset: "))
(princ "\nChon doi tuong offset ")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "Yes No")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong [Yes/No] : "))
(if (null kwrd)
(setq kwrd "No")
)
(foreach obj objlst
(vla-offset obj dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "Yes")
(vla-erase obj)
)
)
)
)
(princ)
)

 

Lệnh này hay quá..... Nhưng có ai giúp mình thêm dòng code cho nó ghi nhớ giá trị Ofset mình vừa nhập không ???

 

Giúp mình với nhé, mình nghĩ chắc nhiều người cũng cần. Chân thành cảm ơ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

Lệnh này hay quá..... Nhưng có ai giúp mình thêm dòng code cho nó ghi nhớ giá trị Ofset mình vừa nhập không ???

 

Giúp mình với nhé, mình nghĩ chắc nhiều người cũng cần. Chân thành cảm ơn !!

Của bạn đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist 110))
(setq dist (getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch Offset : < " (rtos #dist 2 1) " >: ")))
(if dist (setq #dist dist))
(princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset :")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "c k")
(setq kwrd  (getkword "\nXoa doi tuong goc hay khong [C/K] : "))
(if (null kwrd)
(setq kwrd "k")
)
(foreach obj objlst
(vla-offset obj #dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* #dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "c")
(vla-erase obj)
)
)
)
)
(princ)
)

 

Chú ý là nếu bước hỏi có xóa đối tượng gốc hay không, bạn có thể ấn Space (mặc định là 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

Của bạn đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist 110))
(setq dist (getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch Offset : < " (rtos #dist 2 1) " >: ")))
(if dist (setq #dist dist))
(princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset :")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "c k")
(setq kwrd (getkword "\nX\U+00F3a \U+0111\U+1ED1i t\U+01B0\U+1EE3ng g\U+1ED1c kh\U+00F4ng ? [C/K]  "))
(if (null kwrd)
(setq kwrd "K")
)
(foreach obj objlst
(vla-offset obj #dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* #dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "C")
(vla-erase obj)
)
)
)
)
(princ)
)

 

Chú ý là nếu bước hỏi có xóa đối tượng gốc hay không, bạn có thể ấn Space (mặc định là không )

Khi hỏi có xoá đối tượng gốc hay không?Nhấn C thì nó vẫn không xoá đối tượng gốc.Nhờ bạn xem lại giúp.Thanks.

 

Đã up lại code

Chỉnh sửa theo ketxu

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

Bạn dùng thử cái này

(defun c:o2p()
 (setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset: ")))
kc (* (getreal"\n Nhap khoang cach offset: ") 2)
sp (vlax-safearray->list(vlax-variant-value(vla-get-startpoint ob)))
ep (vlax-safearray->list(vlax-variant-value(vla-get-endpoint ob))))
 (command "Mline" "j" "z" "s" kc sp ep "")
 (command "explode" "l" "")
 )

Em thì chỉ dùng trong khi vẽ thép. Vậy bác chỉnh giúp em để đối tượng mới sinh ra thuộc layer "THEP", và đối tượng có màu 4 được ko ạ ?

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

Đăng nhập để thực hiện theo  

×