Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
41 replies to this topic

#21 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 20 July 2012 - 11:45 AM

Bạn sửa lại như thế này, mình k test, viết tạm bạn test nhé


(defun C:CoBlk (/ i ss ls la)
(setq la (if (tblsearch "LAYER" "Block") "Block" (getvar 'clayer)))
(princ "\n Chon Blocks doi mau bylayer <select all>: ")
(setq i 0 ss (ssget '((0 . "INSERT"))))
(if (not ss)(setq ss (ssget "x" '((0 . "INSERT")))))
(command ".UNDO" "BE")
(repeat (sslength ss)
(CoBylayer (ssname ss i))
(setq i (1+ i))
)
(command ".REGEN")
(command ".UNDO" "E")
(princ)
)
(defun CoBylayer (blk / e el s)
(setq s (cdr (assoc 2 (entget blk))))
(if (not (member s ls))
(progn
(setq ls (append ls (list s)))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
(while e
(setq el (entget e))
(if (= "INSERT" (cdr (assoc 0 el)))
(CoBylayer e)
)
(setq el (subst (cons 8 la) (assoc 8 el) el))
(entmod el)
(setq e (entnext e))
)
)
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#22 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 20 July 2012 - 10:14 PM

Chào anh Ket.
Em thử đoạn lisp trên thì thấy là hầu như đều Ok rồi. có điều là em chưa biết chọn "Select all" kiểu gì cả. sau khi gõ lệnh mình chọn đối tượng thì được, nhưng nếu enter tiếp (để chọn All) thì báo lỗi ạ. Anh rảnh thì kiểm tra giúp em nhé. Không thì được thế này cũng tốt rồi ạ.
Em cảm ơn anh nhiều!
  • 0

#23 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 20 July 2012 - 10:29 PM

Để chọn All thì ngay khi hỏi chọn đối tượng bạn Space tiếp.
Chú ý code này có chỗ hay có chỗ dở, nhừng tạm chấp nhận được. Mình vừa test xong
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 20 July 2012 - 11:08 PM

Để chọn All thì ngay khi hỏi chọn đối tượng bạn Space tiếp.
Chú ý code này có chỗ hay có chỗ dở, nhừng tạm chấp nhận được. Mình vừa test xong

Cảm ơn anh Ket.
Có điều này không biết có làm được hay không nhưng em cứ xin nêu ra như sau:
Giả sử mình có Block A, trong A có 2 đối tượng với các tính chất như sau:
- đối tượng B có layer là layer 1, màu là Bylayer - giả sử bylayer của layer 1 ở đây là màu đỏ (màu 1)
- đối tượng C có layer là layer 2, màu cũng là Bylayer- giả sử bylayer của layer 2 ở đây là màu vàng (màu 2)
Khi dùng đoạn lisp trên, chuyển toàn bộ layer của đối tượng B và đối tượng C về layer "Block"
thì ta sẽ được màu của B và C là màu Bylayer (của layer Block) và giả sử là màu xanh greeen (màu 3)
Bây giờ em muốn là: Dù ban đầu màu của B và C là Bylayer nhưng sau khi chuyển layer sang layer Block màu của nó vẫn không thay đổi (trong trường hợp trên,
sau khi chuyển thì màu của B vẫn là màu đỏ, màu của C vẫn là màu vàng, dù layer đã chuyển sang layer Block - có màu xanh)
Nôm na là ta chỉ chuyển layer thôi, còn màu thế nào thì cứ giữ y nguyên như ban đầu của nó vậy.
P/S: Đoạn lisp trên sau khi anh sửa lại thì lại chỉ chuyển layer của B và C sang Layer Block thôi, còn của A thì lại giữ nguyên thì phải ạ!
Chúc anh vui!
  • 0

#25 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 22 July 2012 - 12:13 AM

Anh Ket lúc nào rảnh thì "ngâm cứu" giải quyết giúp em với nhé.
Mong kết quả từ anh từng ngày!
  • 0

#26 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 24 July 2012 - 11:40 AM

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 ạ!
  • 0

#27 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 24 July 2012 - 11:45 AM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#28 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 24 July 2012 - 01:58 PM

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

#29 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 24 July 2012 - 03:26 PM

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

  • 3

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#30 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 24 July 2012 - 04:40 PM

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é!
  • 0

#31 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 24 July 2012 - 04:52 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#32 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 24 July 2012 - 05:06 PM

- 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 ạ!
  • 0

#33 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 24 July 2012 - 05:22 PM

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 :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#34 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 24 July 2012 - 10:33 PM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#35 quickandfine

quickandfine

    biết lệnh copy

  • Members
  • PipPipPip
  • 110 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 25 July 2012 - 01:30 AM

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!
  • 0

#36 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 July 2012 - 11:59 AM

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. ==&gt;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 &quot;mót&quot; 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
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#37 manhhung787

manhhung787

    HVKT-12

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: 16 (tàm tạm)

Đã gửi 26 July 2012 - 03:59 PM

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é)
  • 0

#38 tran.designer.int

tran.designer.int

    biết zoom

  • Members
  • Pip
  • 14 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 27 June 2013 - 09:55 PM

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.c.../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))

  • 0

***Tran thien interior***


#39 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2013 - 11:39 AM

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.c.../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.c..._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))

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#40 tran.designer.int

tran.designer.int

    biết zoom

  • Members
  • Pip
  • 14 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 29 June 2013 - 02:40 PM

Hề hề hề,

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

http://www.cadviet.c..._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. 


  • 0

***Tran thien interior***