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

[Yêu cầu] lisp chuyển các đối tượng về 1 layer

Bởi mua_t7 , trong AutoLisp

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Mấy hôm rồi không thấy hồi âm.

Anh Ket, anh Tue_NV, anh Phamthanhbinh, anh Nguyen Hoanh và các anh khác nữa giúp em với ạ!

Hề hề hề,

Âm chi nữa hè???

Bạn đã test cái lisp của mình chưa mà nói là nó không chuyển lớp của thằng B và C???

Vụ Không đổi màu thì tuy không khó nhưng chả biết bạn có dùng không nên mình cũng chưa muốn bổ sung vào cái lisp của mình.

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

quickandfine    10

quickandfine
Đã đăng

Hề hề hề,

Âm chi nữa hè???

Bạn đã test cái lisp của mình chưa mà nói là nó không chuyển lớp của thằng B và C???

Vụ Không đổi màu thì tuy không khó nhưng chả biết bạn có dùng không nên mình cũng chưa muốn bổ sung vào cái lisp của mình.

Cảm ơn anh trước cái nhé! hehe

Phải nói thật là em đã test đi test lại đoạn lisp của anh rồi, mà nó vẫn chỉ đổi layer của thằng A thôi chứ thằng B và thằng C thì nó vẫn cứng đầu lắm. Không hiểu tại sao, em vừa down lại về test nhưng kết quả vẫn thế. Em đã thử remove hết các lisp em đang dùng do sợ xung đột chẳng hạn nhưng vẫn không được bác ạ. Huuu. Sau khi em chọn block và Enter thì nó vẫn báo lỗi. để chắc ăn em chỉ chọn một block thôi nhé, nó vẫn báo là:

 

Command: clb

Select objects: 1 found

Select objects: ; error: bad argument type: lentityp nil

Nó thông báo như vậy nhưng vẫn chuyển được layer của thằng A sang layer block bác ạ.

Hay thao tác của em lỗi gì chăng???

Cái vụ chuyển màu thì em cũng cần lắm lắm, anh giúp em luôn nhé!

PS: Có Mode nào ghé qua topic này thì xem giúp em xem có lần nào em post bài bị chèn lên nhau không. Nếu có thì nhờ Mod xóa bài thừa và view lại giúp em với nhé. Em đã bị một lần như thế nên khi bac phamthanhbinh post bài mà em chẳng nhìn thấy đâu cả nên anh em cứ hiểu nhầm nhau. Xin các mod thông cảm, tại mạng chỗ em có lúc chập chờn quá, máy em lại hay treo mà em thì cứ sốt ruột quá....

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

Quên béng mất lời hẹn ^^

 



(defun c:test ( / lst ss blkName change)
(defun change ( block layer )
 (vl-load-com)
 (if
   (not
     (vl-catch-all-error-p
       (setq def
         (vl-catch-all-apply 'vla-item
           (list
             (vla-get-blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
               )
             )
             block
           )
         )
       )
     )
   )
   (vlax-for obj def
(vl-catch-all-apply 'vla-put-color (list obj 
(if  (= (setq col (vla-get-color obj)) 256)
(cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj))))
col
)
)) 
(vl-catch-all-apply 'vla-put-layer (list obj layer))
   )
 )
)
(princ "\n Chon Blocks doi mau bylayer <select all>: ")
(setq ss 
 (cond ((ssget (list (cons 0 "INSERT"))))
((ssget "x" (list (cons 0 "INSERT"))))
))
(foreach blk (acet-ss-to-list ss)
(vl-catch-all-apply 'vla-put-layer (list (vlax-ename->vla-object blk) "Block"))
(if (not (vl-position (setq blkName (cdr (assoc 2 (entget blk)))) lst))    
(progn
(change blkName "Block")
(setq lst (cons blkName lst))
)
)
)
 (command "_.regenall")
 (princ)
)

  • Vote tăng 3

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

quickandfine    10

quickandfine
Đã đăng

Quên béng mất lời hẹn ^^

 


(defun c:test ( / lst ss blkName change)
(defun change ( block layer )
 (vl-load-com)
 (if
   (not
     (vl-catch-all-error-p
       (setq def
         (vl-catch-all-apply 'vla-item
           (list
             (vla-get-blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
               )
             )
             block
           )
         )
       )
     )
   )
   (vlax-for obj def
(vl-catch-all-apply 'vla-put-color (list obj
(if  (= (setq col (vla-get-color obj)) 256)
(cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj))))
col
)
))
(vl-catch-all-apply 'vla-put-layer (list obj layer))
   )
 )
)
 (cond ((setq ss (ssget (list (cons 0 "INSERT"))))
(foreach blk (acet-ss-to-list ss)
(vl-catch-all-apply 'vla-put-layer (list (vlax-ename->vla-object blk) "Block"))
(if (not (vl-position (setq blkName (cdr (assoc 2 (entget blk)))) lst))    
(progn
(change blkName "Block")
(setq lst (cons blkName lst))
)
)
)
)
 )
 (command "_.regenall")
 (princ)
)

Anh Ket ơi em chạy thử đoạn lisp của anh nhưng vẫn chưa được anh ạ. Cad không báo lỗi gì nhưng vẫn chưa chuyển được layer của Block cũng như các đối tượng trong block, Anh xem lại giúp em với nhé!

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

quickandfine    10

quickandfine
Đã đăng

- Có thật k ?? Bản vẽ của bạn đã có layer Block chưa ? bạn thao tác ntn ?

À, Sorry anh nhé, Lần trước em dùng lisp kia thì nó tự tạo layer BLock cho em nên em không nghĩ tới chuyện đó, EM tạo mới layer block thì được rồi anh ạ. Nhưng đoạn lisp này lại thiếu mất phần "Select all" đúng không anh?

Cảm ơn anh 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

Bạn thích select all thì mình sửa bên trên. Những cái dễ như vậy hi vọng qua các lần yêu cầu bạn tự làm đượ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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Cảm ơn anh trước cái nhé! hehe

Phải nói thật là em đã test đi test lại đoạn lisp của anh rồi, mà nó vẫn chỉ đổi layer của thằng A thôi chứ thằng B và thằng C thì nó vẫn cứng đầu lắm. Không hiểu tại sao, em vừa down lại về test nhưng kết quả vẫn thế. Em đã thử remove hết các lisp em đang dùng do sợ xung đột chẳng hạn nhưng vẫn không được bác ạ. Huuu. Sau khi em chọn block và Enter thì nó vẫn báo lỗi. để chắc ăn em chỉ chọn một block thôi nhé, nó vẫn báo là:

 

Command: clb

Select objects: 1 found

Select objects: ; error: bad argument type: lentityp nil

Nó thông báo như vậy nhưng vẫn chuyển được layer của thằng A sang layer block bác ạ.

Hay thao tác của em lỗi gì chăng???

Cái vụ chuyển màu thì em cũng cần lắm lắm, anh giúp em luôn nhé!

PS: Có Mode nào ghé qua topic này thì xem giúp em xem có lần nào em post bài bị chèn lên nhau không. Nếu có thì nhờ Mod xóa bài thừa và view lại giúp em với nhé. Em đã bị một lần như thế nên khi bac phamthanhbinh post bài mà em chẳng nhìn thấy đâu cả nên anh em cứ hiểu nhầm nhau. Xin các mod thông cảm, tại mạng chỗ em có lúc chập chờn quá, máy em lại hay treo mà em thì cứ sốt ruột quá....

Hề hề hề,

Sorry vì đúng là có lỗi do mình test với block thuộc tính mà block của bạn không phải block thuộc tính.

Mình đã bổ sung để dùng được với cả block thuộc tính và block thường.

Bạn test lại nhé.

Trong lisp mình viết không đụng chạm gì tới màu sắc của đối tượng. Vì vậy nếu bạn thấy nó bị đổi màu ở đâu thì gửi cái đó cho mình để mình check lại nhé.


(defun c:clb (/ bls)
(vl-load-com)
(if (not (tblsearch "layer" "BLOCK"))
   (command "layer" "m" "Block" "")
)
(alert "\n Chon tap hop cac block muon chuyen layer")
(setq bls (acet-ss-to-list (ssget (list (cons 0 "insert")))))
(foreach b bls     
         (cblc B)     
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cblc (bl / els els1 a )

(setq els (entget bl)
              els (subst (cons 8 "block") (assoc 8 els) els)
)
(entmod els)
(if (and (assoc 66 (entget bl )) (= (cdr (assoc 66 (entget bl ))) 1))
   (progn
       (setq  a (entnext bl) )
       (while (/= (cdr (assoc 0 (entget a))) "SEQEND")
           (if (/= (cdr (assoc 0 (entget a))) "INSERT")
               (progn
                    (setq els1 (entget a)
                         els1 (subst (cons 8 "block") (assoc 8 els1) els1) )
                   (entmod els1)
               )
               (cblc a)
            )
            (setq a (entnext a))
       )
   )
   (progn
         (setq a (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget bl))))))
                   els1 (entget a)   )
         (entmod (subst (cons 8 "block") (assoc 8 els1) els1) )
         (while (setq a (entnext a))
             (if (/= (cdr (assoc 0 (entget a))) "INSERT")
                 (progn
                      (setq els1 (entget a))
                      (entmod (subst (cons 8 "block") (assoc 8 els1) els1) )
                 )
                 (cblc a)
             )
         )
    ) 
)
)

Một lần nữa xin lỗi vì chưa test lisp với bản vẽ bạn gửi.

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

quickandfine    10

quickandfine
Đã đăng

Chào anh Bình nhé.

Em thử lại đoạn lisp của anh thì thấy thế này ạ:

1- Đã chuyển layer của A , B và C về layer Block. ==>Ok.

2- Về vấn đề màu sắc: Nếu màu của B và C được chọn là Bylayer thì khi chuyển về layer Block nó cũng vẫn là Bylayer (bylayer của layer Block). Mong muốn của em là chuyển layer, còn màu thì vẫn giữ nguyên (Anh xem lại yêu cầu ở bài viết số #24 của em nhé)

Đó là ý kiến sau khi em dùng đoạn lisp trên ạ.

PS: Em còn chưa biết block thuộc tính là gì, nhưng yêu cầu của em ở bài viết số 24 đã được anh Ketxu giải quyết. Nếu anh rảnh và muốn hoàn thiện đoạn lisp (theo yêu cầu của em, để nhỡ đâu có lúc nào đó anh lại cần dùng đến, và cả em nữa khi em tìm hiểu thêm về block thuộc tính - hehe) thì anh xem lại nhé. Nếu không thì thôi ạ. Em cảm ơn anh nhiều và chúc anh "mót" thêm được ngày càng nhiều điều hay!

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Chào anh Bình nhé.

Em thử lại đoạn lisp của anh thì thấy thế này ạ:

1- Đã chuyển layer của A , B và C về layer Block. ==>Ok.

2- Về vấn đề màu sắc: Nếu màu của B và C được chọn là Bylayer thì khi chuyển về layer Block nó cũng vẫn là Bylayer (bylayer của layer Block). Mong muốn của em là chuyển layer, còn màu thì vẫn giữ nguyên (Anh xem lại yêu cầu ở bài viết số #24 của em nhé)

Đó là ý kiến sau khi em dùng đoạn lisp trên ạ.

PS: Em còn chưa biết block thuộc tính là gì, nhưng yêu cầu của em ở bài viết số 24 đã được anh Ketxu giải quyết. Nếu anh rảnh và muốn hoàn thiện đoạn lisp (theo yêu cầu của em, để nhỡ đâu có lúc nào đó anh lại cần dùng đến, và cả em nữa khi em tìm hiểu thêm về block thuộc tính - hehe) thì anh xem lại nhé. Nếu không thì thôi ạ. Em cảm ơn anh nhiều và chúc anh "mót" thêm được ngày càng nhiều điều hay!

Hề hề hề,

Đây là cái mình bổ sung thêm, không biết đã đúng ý bạn chưa.

bạn lưu ý là màu của block khác với màu của các đối tượng trong block nhé. Ở đây mình đổi tuốt luốt để nó giữ nguyên màu i sì như block gốc, chỉ chuyển tên layer mới là block thôi.

(defun c:clb (/ bls)
(vl-load-com)
(if (not (tblsearch "layer" "BLOCK"))
   (command "layer" "m" "Block" "")
)
(alert "\n Chon tap hop cac block muon chuyen layer")
(setq bls (acet-ss-to-list (ssget (list (cons 0 "insert")))))
(foreach b bls     
         (cblc B)     
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cblc (bl / els els1 a )

(setq els (entget bl) )
(chc els)
(setq els (subst (cons 8 "block") (assoc 8 els) els) )
(entmod els)

(if (and (assoc 66 (entget bl )) (= (cdr (assoc 66 (entget bl ))) 1))
   (progn
       (setq  a (entnext bl) )
       (while (/= (cdr (assoc 0 (entget a))) "SEQEND")
           (if (/= (cdr (assoc 0 (entget a))) "INSERT")
               (progn
                    (setq els1 (entget a) )
                    (chc els1)
                    (setq els1 (subst (cons 8 "block") (assoc 8 els1) els1) )
                    (entmod els1)

               )
               (cblc a)
            )
            (setq a (entnext a))
       )
   )
   (progn
         (setq a (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget bl))))))
                   els1 (entget a)   )
         (chc els1)
         (entmod (subst (cons 8 "block") (assoc 8 els1) els1) )

         (while (setq a (entnext a))
             (if (/= (cdr (assoc 0 (entget a))) "INSERT")
                 (progn
                      (setq els1 (entget a))
                      (chc els1)
                      (entmod (subst (cons 8 "block") (assoc 8 els1) els1) )                       
                 )
                 (cblc a)
             )
         )
    ) 
)
)
;;;;;;;;;;;;;;;;;;;;;;
(defun chc (el / col)
(if (= (cdr (assoc 62 el)) nil)
    (progn 
          (setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 el))))))
          (entmod (cons (cons 62 col) el))
    )
)
)

Chúc bạn vui

  • 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

manhhung787    16

manhhung787
Đã đăng

anh bình cho e xin cái lisp chuyển tất cả bog bao gồm cả blog con về layer hiện hành nhé chuyển cả màu nữa anh nhé(cho cả 2 trường hơp blog ATT và không phải dạng ATT nhé)

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

tran.designer.int    2

tran.designer.int
Đã đăng

Chào cả nhà! 

Mình mới nghiên cứu về lisp, không biết trên diễn đàn đã có ai hỏi về vấn đề  vẽ bậc thang chưa? Mình có đoạn lisp về cầu thang cần mọi người góp ý! 

Mình muốn vẽ mủi bậc thang cách điểm chọn 1 góc tọa độ xoy (20mm,20mm). Mong các bác giúp đỡ! Thank các bác nhìu nhìu!

http://www.cadviet.com/upfiles/3/118057_btm.lsp

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))

 118057_hinh_minh_hoa.jpg

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
 
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

 

Chào cả nhà! 

Mình mới nghiên cứu về lisp, không biết trên diễn đàn đã có ai hỏi về vấn đề  vẽ bậc thang chưa? Mình có đoạn lisp về cầu thang cần mọi người góp ý! 

Mình muốn vẽ mủi bậc thang cách điểm chọn 1 góc tọa độ xoy (20mm,20mm). Mong các bác giúp đỡ! Thank các bác nhìu nhìu!

http://www.cadviet.com/upfiles/3/118057_btm.lsp

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))

 118057_hinh_minh_hoa.jpg

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
 
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))
(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(princ))

Hề hề hề,

Phải chăng bạn muốn cái này:

http://www.cadviet.com/upfiles/3/5194_vebacthang.lsp

 

Xin lưu ý bạn là lisp này chỉ vẽ bậc thang theo kiểu bạn đang dùng là từ trái qua phài và từ dưới lên trên. Còn nếu bạn muốn vẽ thang kiểu khác thì sẽ không còn đúng nữa.

 

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(command ".pline")
(command (list (+ (car p) 20) (- (cadr p) 20)) )
(repeat sb
(command
(strcat "@0," (rtos c))
(strcat "@" (rtos r) ",0")
;;;"a"
;;;(strcat "@0," (rtos (* 2.0 bk)))
;;;"l"
;;;(strcat "@" (rtos (+ (- nb bk) r)) ",0")
))
(command "")
(setq e1 (entlast))
(command "break" e1 (list (+ (car p) 20) (cadr p)) (list (+ (car p) 20) (- (cadr p) 20)) )
(setq e2 (entlast))
(command "break" e2 (list (+ (car p) (* sb r)) (- (+ (cadr p) (* sb c)) 20)) (list (+ (car p) (* sb r) 20) (- (+ (cadr p) (* sb c)) 20)) )
 
(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

tran.designer.int    2

tran.designer.int
Đã đăng

 

Hề hề hề,

Phải chăng bạn muốn cái này:

http://www.cadviet.com/upfiles/3/5194_vebacthang.lsp

 

Xin lưu ý bạn là lisp này chỉ vẽ bậc thang theo kiểu bạn đang dùng là từ trái qua phài và từ dưới lên trên. Còn nếu bạn muốn vẽ thang kiểu khác thì sẽ không còn đúng nữa.

 

(defun c:BTM (/ p c r sb oldos)
(setq
nb 20.0
bk 10.0
p (getpoint "\nVao diem dau tien: ")
c (getdist p "\nVao chieu cao bac: ")
r (getdist p "\nVao chieu rong bac: ")
sb (getint "\nVao so bac: ")
oldos (getvar "osmode"))
(setvar "osmode" 0 )
(command ".pline")
(command p)
(repeat sb
(command
(strcat "@0," (rtos (- c (* 2.0 bk))))
(strcat "@" (rtos (- bk nb)) ",0")
"a"
(strcat "@0," (rtos (* 2.0 bk)))
"l"
(strcat "@" (rtos (+ (- nb bk) r)) ",0")))
(command "")
(command ".pline")
(command (list (+ (car p) 20) (- (cadr p) 20)) )
(repeat sb
(command
(strcat "@0," (rtos c))
(strcat "@" (rtos r) ",0")
;;;"a"
;;;(strcat "@0," (rtos (* 2.0 bk)))
;;;"l"
;;;(strcat "@" (rtos (+ (- nb bk) r)) ",0")
))
(command "")
(setq e1 (entlast))
(command "break" e1 (list (+ (car p) 20) (cadr p)) (list (+ (car p) 20) (- (cadr p) 20)) )
(setq e2 (entlast))
(command "break" e2 (list (+ (car p) (* sb r)) (- (+ (cadr p) (* sb c)) 20)) (list (+ (car p) (* sb r) 20) (- (+ (cadr p) (* sb c)) 20)) )
 
(princ))

Cám ơn Bác nhiều! Dù sao thì cũng gần giống ý em. Em chỉ cần vẽ btm với 1 nét của chính bản thân nó thôi. 

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

phamthe    1

phamthe
Đã đăng

Lisp O2L (Object to layer) dưới đây sẽ giúp bạn. Nếu bạn muốn chuyển các đối tượng khác, bạn hãy copy rồi thêm dòng lệnh (cons "KIEUDOITUONG" "TENLAYER") vào cụm các lệnh cons phía dưới.

 

(defun c:o2l ( / ss pp lstoblayer)  (setq    lstoblayer     (list       (cons "DIMENSION" "DIM")		; chuyen doi tuong Dimension ve layer DIM        (cons "HATCH" "HATCH")       (cons "INSERT" "BLOCK")		; BLOCK (la doi tuong insert) ve layer BLOCK       (cons "*TEXT" "TEXT")		; TEXT va MTEXT ve layer text     )      )  (foreach pp lstoblayer        (setq ss (ssget "X" (list (cons 0 (car pp)))))    (if (not (tblsearch "layer" (cdr pp)))      (command ".layer" "m" (cdr pp) "")    )    (command ".chprop" ss "" "la" (cdr pp) "")      )    (princ))

các bác cho em hỏi nếu muốn đổi tên Layer A sang tên Layer B trong code này thì làm thế nào nhỉ?

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

leetunghoanh    0

leetunghoanh
Đã đăng

sorry các bác , các bác có thể phát triên thêm một lisp kiểu đổi layer như sau:

 

Toàn bộ các đối tượng đang thuộc layer tên là AA_hatch trong bản vẽ sẽ tự chuyển thành layer BB_netto

Toàn bộ các đối tượng đang thuộc layer tên là AA_border trong bản vẽ sẽ tự chuyển thành layer BB_duongbien

Toàn bộ các đối tượng đang thuộc layer tên là AA_rebar trong bản vẽ sẽ tự chuyển thành layer BB_thep

.....

 

Nói chung ý tưởng là sẽ đổi nhiều đối tượng thuộc các layer khác nữa, nhưng muốn đổi layer nào thì người dùng sẽ tự copy thêm lệnh vào lisp 

Cảm ơn các bá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

Danh Cong    422

Danh Cong
Đã đăng
16 giờ trước, leetunghoanh đã nói:

Toàn bộ các đối tượng đang thuộc layer tên là AA_hatch trong bản vẽ sẽ tự chuyển thành layer BB_netto

Toàn bộ các đối tượng đang thuộc layer tên là AA_border trong bản vẽ sẽ tự chuyển thành layer BB_duongbien

Toàn bộ các đối tượng đang thuộc layer tên là AA_rebar trong bản vẽ sẽ tự chuyển thành layer BB_thep

Nói chung ý tưởng là sẽ đổi nhiều đối tượng thuộc các layer khác nữa, nhưng muốn đổi layer nào thì người dùng sẽ tự copy thêm lệnh vào lisp 

Bạn có thể liên hệ với bác này : @ketxu : 0989 728 788

Video thì nó thế này: 

Lisp thì có phí :)))

 

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
×