[Yêu cầu]Viết lisp offset, dim, layer

[dragontalon0802 4]

Như hình vẽ mình nhờ bro nào viết hộ các lisp sau:

1. Lisp offset 2 bên với giá trị cho trước, dv mình ấn lệnh "q2" từ đường

màu đỏ sẽ offset ra 2 đường màu xanh với khoảng cách offset là 110.

(trên diễn đàn đã có lisp offset 2 phía nhưng mình muốn tiện hơn)

2. Lisp dóng khoảng cách giữa các dim: ví dụ mình chọn dim2 ấn lệnh "kd",

nhập khoảng cách 300 và kích vào dim1 thì sẽ được như hình.

3. Lisp copy trục: Mình làm block vòng tròn có đánh số 1,

sau khi nhập lệnh "ct" và đánh khoảng cách hoặc kích điểm để copy thì

sẽ được block có số 2, kích nữa thì có block số 3.

4. Lisp chuyển tất cả đối tượng của layer này sang layer khác kể cả đã block(layer chọn trở nên rỗng)

Mình đã thử dùng lệnh layiso nhưng nếu đối tượng đó bị block thì chịu.

 

Yêu cầu hơi nhiều bạn nào giúp được phần nào thì giúp nhé. Thanks đã quan tâm.

[ketxu 2.984]

Mình giúp được phần 4 nè , yêu cầu tương đương với lệnh laymrg của Express :lol:

[dragontalon0802 4]

lệnh laymrg của Express :lol:

Là sao bạn? Giải thích cụ thể hơn được không? Mình thử mà không được.

[ketxu 2.984]

Nếu máy bạn đã cài Express thì đánh Laymrg, chọn các đối tượng thuộc các layer muốn chuyển, enter, chọn đối tượng thuộc layer đích , enter. Nếu máy bạn chưa cài Express thì chịu khó cài vào. CHúc bạn thành công

 

Lisp1 :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq #dist (/ 110 (getvar "dimlfac")))
(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)
(vla-offset obj (* #dist -1))
(if (eq kwrd "c")
(vla-erase obj)
)
)
)
)
(princ)
)

[lp_hai 225]

Như hình vẽ mình nhờ bro nào viết hộ các lisp sau:

1. Lisp offset 2 bên với giá trị cho trước, dv mình ấn lệnh "q2" từ đường

màu đỏ sẽ offset ra 2 đường màu xanh với khoảng cách offset là 110.

(trên diễn đàn đã có lisp offset 2 phía nhưng mình muốn tiện hơn)

2. Lisp dóng khoảng cách giữa các dim: ví dụ mình chọn dim2 ấn lệnh "kd",

nhập khoảng cách 300 và kích vào dim1 thì sẽ được như hình.

3. Lisp copy trục: Mình làm block vòng tròn có đánh số 1,

sau khi nhập lệnh "ct" và đánh khoảng cách hoặc kích điểm để copy thì

sẽ được block có số 2, kích nữa thì có block số 3.

4. Lisp chuyển tất cả đối tượng của layer này sang layer khác kể cả đã block(layer chọn trở nên rỗng)

Mình đã thử dùng lệnh layiso nhưng nếu đối tượng đó bị block thì chịu.

 

Yêu cầu hơi nhiều bạn nào giúp được phần nào thì giúp nhé. Thanks đã quan tâm.

những yêu cầu này trên diễn đàn có rồi :unsure:

1)bạn muốn tiện hơn ở điểm nào?

2)bạn seach "lisp chỉnh khoảng cách dim"

3)search lisp "od_oc_oca"

4)bạn có thể dùng lệnh laytrans

[dragontalon0802 4]

những yêu cầu này trên diễn đàn có rồi :unsure:

1)bạn muốn tiện hơn ở điểm nào?

2)bạn seach "lisp chỉnh khoảng cách dim"

3)search lisp "od_oc_oca"

4)bạn có thể dùng lệnh laytrans

1. Tiện hơn vì khi vẽ tường mình không phải nhập số.

2+3. Mình shearch rồi nhưng không được, do ít vào diễn đàn nên nhiều cái mình hơi gà.

4. thử mà ko hiểu gì cả.

Thanks bạn đã quan tâm, nếu có thể thì giúp mình tìm hơn vì mình mò hơn 2h mà vẫn chưa ra. :wacko:

[dragontalon0802 4]

Nếu máy bạn đã cài Express thì đánh Laymrg, chọn các đối tượng thuộc các layer muốn chuyển, enter, chọn đối tượng thuộc layer đích , enter. Nếu máy bạn chưa cài Express thì chịu khó cài vào. CHúc bạn thành công

 

Lisp1 :

 

Mình đã thử lisp trên nhưng không đuợc, mình đã kiểm tra kỹ lệnh tắt và các lisp lệnh khác thấy ko bị trùng lệnh, đã tắt unikey.

Nhờ bạn xem lại hộ mình. Thanks

[ketxu 2.984]

Bạn trả lời mình câu này trước : Máy bạn cài Express chưa, rồi thì ta bàn tiếp

[dragontalon0802 4]

Mình không biết về Express, mình google thì thấy cad 2007 mình dùng có sẵn Express. Không biết có đúng không. Mình muốn hỏi là lisp cad bạn đưa ra không dùng được, nhờ bạn kiểm tra lại lisp dùm mình. Cảm ơn :rolleyes:

[lp_hai 225]

1. Tiện hơn vì khi vẽ tường mình không phải nhập số.

2+3. Mình shearch rồi nhưng không được, do ít vào diễn đàn nên nhiều cái mình hơi gà.

4. thử mà ko hiểu gì cả.

Thanks bạn đã quan tâm, nếu có thể thì giúp mình tìm hơn vì mình mò hơn 2h mà vẫn chưa ra. :wacko:

lisp căn chỉnh dim này là của pác Hoành. mình có chỉnh lại chút cho đúng yêu cầu của bạn:

(defun c:sdd ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
)
(princ (strcat "\n" msg))
)
(done)
)
;;----------
(defun init ()
(setq
HOANH_CMD (getvar "CMDECHO")
HOANH_OLDERROR *error*
*error* hoanh_newerror

)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
)
;;----------
(defun done ()
(command ".redraw")
(command ".undo" "E")
(if HOANH_CMD
(setvar "CMDECHO" HOANH_CMD)
)
(if HOANH_OLDERROR
(setq *error* HOANH_OLDERROR)
)
(princ)
)
;;----------

(defun cdim (entdt pchan pduong / tt old10
old13 old14 new10 new13 new14 p10n
p13n p14n p10o p13o p14o gocduong
gocchan pchanb pduongb loaidim
)
(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)
(setq
goc (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq (inters ph ptemp p1 p2 nil)
)
pkq
)
(setq
tt (entget entdt)
old10 (assoc '10 tt)
old13 (assoc '13 tt)
old14 (assoc '14 tt)
p10o (cdr old10)
p13o (cdr old13)
p14o (cdr old14)
loaidim (logand (cdr (assoc '70 tt)) 7)
gocduong (cond
((= loaidim 1) (angle p13o p14o))
((= loaidim 0) (cdr (assoc '50 tt)))
(t nil)
)
pchan (cond
(pchan (list (car pchan) (cadr pchan) 0.0))
(t pchan)
)
pduong (cond
(pduong (list (car pduong) (cadr pduong) 0.0))
(t pduong)
)

)
(if gocduong
(progn
(if pchan
(setq
pchanb (polar pchan gocduong 1000.0)
p13n (chanvuonggoc
(list (car p13o) (cadr p13o) 0.0)
pchan
pchanb
)
p14n (chanvuonggoc
(list (car p14o) (cadr p14o) 0.0)
pchan
pchanb
)
new13 (cons 13 p13n)
new14 (cons 14 p14n)
tt (subst new13 old13 tt)
tt (subst new14 old14 tt)
)
)
(if pduong
(setq
pduongb (polar pduong gocduong 1000.0)
p10n (chanvuonggoc
(list (car p10o) (cadr p10o) 0.0)
pduong
pduongb
)
new10 (cons 10 p10n)
tt (subst new10 old10 tt)
)
)
(entmod tt)
)
)
gocduong
)

(defun textdimheight (ent / tmp)
(command ".copy" ent "" (list 0.0 0.0 0.0) "@")
(command ".explode" (entlast) "")
(setq tmp (cdr (assoc 40 (entget (entlast)))))
(command ".erase" "p" "")
tmp
)
(defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
(setq
x1 (car p1)
y1 (cadr p1)
z1 (caddr p1)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
x3 (car p3)
y3 (cadr p3)
z3 (caddr p3)
tmp (+ (* (- x1 x2) x3)
(* (- y1 y2) y3)
(* (- z1 z2) z3)
)
)
(cond
((= tmp 0.0) 0.0)
(t (/ tmp (abs tmp)))
)
)
(defun khoangcachdim (p1 ent goc / tt p2 A B D)
(setq tt (entget ent)
p2 (cdr (assoc 10 tt))
B (cdr (assoc 50 tt))
A (angle p1 p2)
D (distance p1 p2)
)
(* (* D (sin (- A B ))) (phia p1 (polar p1 goc 1.0) p2))
)

(defun phanloai (ent)
(setq
kc (khoangcachdim pgoc ent goc)
loai (fix (/ kc heightdimgoc 0.93))
)
(cons loai ent)
)

(init)
(princ "\nSap xep dim © CADViet.com")
(while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
)
(setq
ttgoc (entget entgoc)
p13goc (cdr (assoc 13 ttgoc))
pgoc (cdr (assoc 10 ttgoc))
goc (cdr (assoc 50 ttgoc))
cao (getdist "\nnhap khoang cach cac dim: ")
ssd (ssget (list
(cons 0 "DIMENSION")
(cons -4 "<OR")
(cons 70 32)
(cons 70 64)
(cons 70 96)
(cons 70 128)
(cons 70 160)
(cons 70 196)
(cons 70 224)
(cons -4 "OR>")
(cons -4 "<OR")
(cons 50 goc)
(cons 50 (+ goc pi))
(cons 50 (- goc pi))
(cons -4 "OR>")
)
)
lstd (ss2ent ssd)
lstd (mapcar 'phanloai lstd)
lstlevel nil
)
(foreach pp lstd
(if (not (member (car pp) lstlevel))
(setq lstlevel (append lstlevel (list (car pp))))
)
)
(setq lstlevel (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam nil
lstduong nil
lstamtmp nil
lstduongtmp nil
)
(foreach pp lstlevel
(if (< pp 0.0)
(setq lstam (append lstam (list pp)))
)
(if (> pp 0.0)
(setq lstduong (append lstduong (list pp)))
)
)
(setq index 0)
(foreach pp (reverse lstam)
(setq
index (1+ index)
lstamtmp (append lstamtmp (list (cons pp index)))
)
)
(setq
lstam lstamtmp
index 0
)
(foreach pp lstduong
(setq
index (1+ index)
lstduongtmp (append lstduongtmp (list (cons pp index)))
)
)
(setq lstduong lstduongtmp)
(setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

(setq kcdimstandard cao)
(foreach pp lstd
(setq plht (car pp))
(progn
(setq
kcdimht (khoangcachdim pgoc (cdr pp) goc)
duongthu (cdr (assoc plht lstlevel))
heso (cond
((/= 0 kcdimht)
(abs (* (/ kcdimstandard kcdimht) duongthu))
)
(t 0.0)
)
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi (polar pgoc
(angle pgoc diemchenht)
(* heso (distance pgoc diemchenht))
)
)

(cdim (cdr pp) p13goc pmoi)
)
)
(done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)

còn đây là lisp copy block ATT tăng dần:

http://www.cadviet.com/forum/index.php?showtopic=34029

[lp_hai 225]

trên đây là lệnh laytrans.

1)sau khi gõ lệnh trên hộp thoại bạn chọn layers cần thay đổi (trong hình VD là layer 222).

2)bấm vào ô load để chọn file có layer mà bạn muốn đổi layer 222 sang. có thể mở chình file hiện tại hoặc file khác.

3)chọn layer mới (trong hình mình VD là Layer 111)

4)bấm nút translate.

[ketxu 2.984]

Mình không biết về Express, mình google thì thấy cad 2007 mình dùng có sẵn Express. Không biết có đúng không. Mình muốn hỏi là lisp cad bạn đưa ra không dùng được, nhờ bạn kiểm tra lại lisp dùm mình. Cảm ơn :rolleyes:

Chào bạn. Nếu CAD có sẵn Express thì sẽ dùng được lệnh Laymrg (nội bộ bản vẽ) hoặc Laytrans

Về laytrans bạn có thể đọc bài bác lp_hai đã post, hoặc ngó qua đây

Laytrans

- Về lisp mình post, sorry vì mình type bất cẩn quá, mình đã sửa lại, bạn hãy down lại nhé

[dragontalon0802 4]

@ lp_hai : lisp sdd.lsp không dùng được bạn à, mình đã thao tác như hình và enter nhưng không có kết quả

Lisp copy tăng dần :

lệnh od dùng bt nhưng mình ko thấy có tác dụng lắm vì căn chỉnh font chữ mất time

lệnh oc dùng bị lỗi

lệnh oca dùng ko được, hình trên là dùng lần lượt 2 lệnh oc và oca

@ketxu : lisp vẫn không dùng đuợc bạn à.

lệnh Laymrg đã giải quyết vấn đề mình cần.

 

Thanks những người nhiệt tình và tâm huyết như các bạn.

[ketxu 2.984]

@

@ketxu : lisp vẫn không dùng đuợc bạn à.

lệnh Laymrg đã giải quyết vấn đề mình cần.

 

Bạn tự cho thêm dòng (vl-load-com) vào đầu lisp nhé

[dragontalon0802 4]

Bạn tự cho thêm dòng (vl-load-com) vào đầu lisp nhé

Mình làm được rồi, nhưng mình muốn để mặc định là không xóa đối tượng gốc thì làm sao nhỉ? Mình nhờ làm cái lisp này chủ yếu

vẽ nhanh hơn mà bị hỏi xóa đối tượng gốc hay không làm mất time.

Thanks bạn.

[ketxu 2.984]

Mình làm được rồi, nhưng mình muốn để mặc định là không xóa đối tượng gốc thì làm sao nhỉ? Mình nhờ làm cái lisp này chủ yếu

vẽ nhanh hơn mà bị hỏi xóa đối tượng gốc hay không làm mất time.

Thanks bạn.

Mình bị dị ứng với dòng màu xanh ^^

Phần hỏi xóa đối tượng hay không, nếu bạn space thì mặc định là không xóa rồi, chỉ mất thêm 1 thao tác 0,3s thôi. Còn nếu bạn không quen thì đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(vl-load-com)
(grtext -1 "Free from CADviet @ketxu")
(setq #dist (/ 110 (getvar "dimlfac")))
(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)))))
(foreach obj objlst
(vla-offset obj #dist)
(vla-offset obj (* #dist -1))
)
)
)
(princ)
)

[dragontalon0802 4]

Mình bị dị ứng với dòng màu xanh ^^

Phần hỏi xóa đối tượng hay không, nếu bạn space thì mặc định là không xóa rồi, chỉ mất thêm 1 thao tác 0,3s thôi. Còn nếu bạn không quen thì đây :

Được rồi, thanks. nếu rỗi thì nhờ giúp mình 2 cái lisp còn lại nhé :rolleyes: (hơi tham)

[ketxu 2.984]

Bạn cần post tối thiểu bản vẽ trình bày ý tưởng, block mẫu... của bạn lên, không thì giỏi mắy cũng đành chịu bạn ạ

[dragontalon0802 4]

Bạn cần post tối thiểu bản vẽ trình bày ý tưởng, block mẫu... của bạn lên, không thì giỏi mắy cũng đành chịu bạn ạ

Bạn xem lại hộ mình post #1, mình nghĩ cái đó nếu trình bày đơn giản mà. Với lại copy trục thì trong diễn đàn có rồi nhưng mình tìm không được.

Bạn xem mấy bản vẽ xây dựng có đánh trục (1),(2),(3)...thì mình muốn có lisp để khi copy nó tự động nhảy số cho mình thôi mà.