Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
dragontalon0802

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

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

cad1.png

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.

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.652

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:

  • 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
ketxu    2.652

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)
)

  • 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
lp_hai    207

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

  • 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

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:

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

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

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.652

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

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 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:

  • Vote giảm 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
lp_hai    207

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

  • 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
lp_hai    207

laytrans.jpg

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.

  • 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
ketxu    2.652

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é

  • 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

@ 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ả

cad.jpg

Lisp copy tăng dần :

cad2.png

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.

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.652

@

@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é

  • 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 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.

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.652

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)
)

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 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)

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.652

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 ạ

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 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à.

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  

×