Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] lsp tách 1 nhóm layer thành nhiều layer khác nhau


  • Please log in to reply
39 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 02 November 2012 - 01:22 PM

Tự tạo thì e search từ tạo layer trên diễn đàn, nhiều vô kể, tìm và paste vào đầu lisp. A viết cũng chỉ thêm 2 dòng nữa, nhưng đó là kết quả yêu cầu thiếu thốn của em.
Ngoài ra phần lý thuyết lớp lisp đã có, chương 8, level 3, áp dụng command và lệnh -layer, e có thể xem và tự làm

P/s : à phần LOAIRUONGDAT e chuyển STR thành SYM nhé
  • 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


#22 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 02 November 2012 - 01:28 PM

Fix để nhận luôn layer LOAIRUONGDAT

(defun c:test(/ ss a )(vl-load-com)
(setq a '((INT . "SOTHUA")(REAL . "DIENTICH")(SYM . "LOAIRUONGDAT"))
tmp (ssget (list (cons 0 "TEXT")(cons 8 "13")))
)
(vlax-for x (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq tmp (assoc (type (read (vla-get-textstring x))) a))
(vla-put-layer x (cdr tmp))
)
)
)

  • 3

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#23 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 02 November 2012 - 02:30 PM

Tuyệt vời! Đã có kết quả rồi.
Nhưng nhìn bản vẽ đoán là chủ topic muốn thống kê đất theo bảng. Nếu như đúng vậy có lẽ đua bản vẽ từ đầu và nhờ giúp luôn thì chắc nhanh hơn nhiều.
  • 0

#24 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 02 November 2012 - 03:00 PM

Nếu HHVD chỉ cần viết "STR" >> "SYM" thì vừa đỡ tốn đất vừa tránh hiểu nhầm.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#25 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 02 November 2012 - 04:27 PM

Nếu HHVD chỉ cần viết "STR" >> "SYM" thì vừa đỡ tốn đất vừa tránh hiểu nhầm.


1. Lisp mình upload ở trên là của ketxu. Nhưng ketxu thiếu xót chổ STR và SYM nên mình fix giúp. Và upload cho vào thẻ code để ai không biết lisp hoặc ai đó search thấy lisp mà không theo dõi hết topic cung có thể dùng. Mọi người Like cho ketxu ấy.
2. Mình viết lại lisp, Mình viét theo ý mình. Đối tượng chọn ở đây là block chứ không cần explode chọn text như ketxu.
Hi vọng trúng ý chủ topic.

(defun dxf (code e) (cdr (assoc code (entget e))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
)
(defun CreatLayer(MyLayer / MyColor)
(if (not (tblsearch "LAYER" MyLayer))
(progn
(entmakex
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 70 0)
(cons 2 MyLayer)
)
)
)
)
)
(defun c:test2 (/ ss a el qa kq i dt type_dt)
(vl-load-com)
(CreatLayer "SOTHUA")
(CreatLayer "DIENTICH")
(CreatLayer "LOAIRUONGDAT")
(setq ss (ssget (list (cons 0 "INSERT") (cons 8 "13"))))
(setq el (entlast) kq (ssadd))
(setq qa (getvar 'QAFLAGS))
(setvar 'QAFLAGS 1)
(command "explode" ss "")
(setvar 'QAFLAGS qa)
(while (setq en (entnext el))
(if (= (dxf 0 en) "TEXT") (ssadd en kq))
(setq el en)
)
(repeat (setq i (sslength kq))
(setq dt (ssname kq (setq i (1- i))))
(setq type_dt (type (read (dxf 1 dt))))
(cond
((= type_dt 'INT) (PUT-GC "SOTHUA" 8 dt))
((= type_dt 'REAL) (PUT-GC "DIENTICH" 8 dt))
((= type_dt 'SYM) (PUT-GC "LOAIRUONGDAT" 8 dt))
)
)
(princ "\nHochoaivandot - Cadviet.com")
)

Ketxu viết đã đáp ứng yêu cầu của chủ topic, nhưng tại thấy ấy nấy mọi người Like nhầm cho mình nên mình viết lại. Hìhì! Hi vọng giúp thêm được bạn ấy mà không thừa.
  • 2

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#26 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 02 November 2012 - 06:25 PM

K có j thừa với lòng nhiệt tình cả ^^ Mỗi lisp là một bài học. Dào này ket ít viết lắm, mà vẫn chăm chỉ download của mọi người về mót, nhiều lúc sướng hết cả người.Hehe. Tks bạn
  • 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


#27 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 02 November 2012 - 06:39 PM

em cám ơn anh ketxu và anh hochoaivandot đã tận tình giúp đỡ em về lsp nay, em còn may lsp nũa cua cong ty nhung em cung mun chinh sua xíu, nếu mấy anh có hứng thú em sẽ post lên để mọi người cùng tham khảo trao đổi hihi
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#28 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 02 November 2012 - 09:40 PM

@nhoclangbat: bạn đang có 1 người thầy tuyệt vời. Không khai thác hết là quá phí học phí!
@hochoaivandot: bản ẩn mình một thời gian dài, bỗng trỗi dậy với đầy tiềm năng trong từng dòng code.
  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#29 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 02 November 2012 - 11:22 PM

Mình cũng thường xuyên làm bản đồ như thế nhưng phải làm xóa thủ công không, nay thất lisp này thì dow ve nhung không sử dụng được. Mình up file này lên nhờ mọi người coi dùm. http://www.cadviet.c..._p15_q11new.dwg
  • 0

#30 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 November 2012 - 09:03 AM

file của bạn mình xem thử rùi, mà bạn dùng lsp nào lsp của anh ket hay anh HHVD, nếu bạn dùng lsp của anh ket thì nếu trước tiên những đối tượng đó là block phải phá block và chỉ đổi layer đc khi trong file đã có sẵn 3 layer cần đổi, anh ket đã kêu mình nếu trong file ko có layer đó thì trong lsp phải có thêm lệnh tạo các layer đó, lsp mới thực thi đc, còn lsp của anh HHVD thì ko cần phá block quét chọn hết đối tượng đó chạy lsp tự động tạo ra các layer đó, tự phá block và chuyển layer lun, trường hợp file của bạn đã có nhửng layer đó rùi, những đối tượng đó ko còn là block nữa thì chỉ cần dùng lsp của anh ket là ok mình cũng đã thử, nếu file bản đồ gốc của bạn đối tượng đó là block thì dùng lsp của anh HHVD. nếu trong file của bạn ko có sẵn những layer đó thì mình sẽ psot lsp của anh ket mà anh ket chỉ mình nếu mún lsp tự tạo các layer đó thì thêm vài dòng lệnh là ok, mình đã mò mẫn và sữa lại thành công hihi.
PS: dùng lsp của anh HHVD thì đối tượng đó phải là block nha bạn, nếu đã phá block rùi thì dùng ko đc đâu.
lsp của anh ket mình đã chỉnh sữa

(defun c:test(/ ss a )(vl-load-com)
(COMMAND "LAYER" "M" "SOTHUA" "C" "3" "" "")
(COMMAND "LAYER" "M" "DIENTICH" "C" "3" "" "")
(COMMAND "LAYER" "M" "LOAIRUONGDAT" "C" "3" "" "")
(setq a '((INT . "SOTHUA")(REAL . "DIENTICH")(SYM . "LOAIRUONGDAT"))
tmp (ssget (list (cons 0 "TEXT")(cons 8 "13")))
)
(vlax-for x (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq tmp (assoc (type (read (vla-get-textstring x))) a))
(vla-put-layer x (cdr tmp))
)
)
)

  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#31 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 06 November 2012 - 07:02 AM

may anh ơi em có ý này ko pit đc ko, mình có thể kết hợp lsp của anh Ket va anh HHVD đc ko ta, vd khi ta chạy lsp quét đối tượng, khi đó lsp sẽ tiến hành nhận dạng nếu là block thì chạy hàm của anh HHVD nếu ko phải block thì chạy của anh Ket hihi hơi tham
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#32 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 06 November 2012 - 04:34 PM

Thank nhoclangbat nhiều! lisp đã chạy tốt.
  • 0

#33 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 06 November 2012 - 08:18 PM

may anh ơi em có ý này ko pit đc ko, mình có thể kết hợp lsp của anh Ket va anh HHVD đc ko ta, vd khi ta chạy lsp quét đối tượng, khi đó lsp sẽ tiến hành nhận dạng nếu là block thì chạy hàm của anh HHVD nếu ko phải block thì chạy của anh Ket hihi hơi tham


(defun dxf (code e) (cdr (assoc code (entget e))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
)
(defun CreatLayer(MyLayer / MyColor)
(if (not (tblsearch "LAYER" MyLayer))
(progn
(entmakex
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 70 0)
(cons 2 MyLayer)
)
)
)
)
)
(defun ChangeLayer(kq / i dt type_dt)
(repeat (setq i (sslength kq))
(setq dt (ssname kq (setq i (1- i))))
(setq type_dt (type (read (dxf 1 dt))))
(cond
((= type_dt 'INT) (PUT-GC "SOTHUA" 8 dt))
((= type_dt 'REAL) (PUT-GC "DIENTICH" 8 dt))
((= type_dt 'SYM) (PUT-GC "LOAIRUONGDAT" 8 dt))
)
)
)
(defun c:test2 (/ ss el qa kq i)
(vl-load-com)
(CreatLayer "SOTHUA")
(CreatLayer "DIENTICH")
(CreatLayer "LOAIRUONGDAT")
(setq ss (ssget (list (cons 8 "13"))) kq (ssadd))
(setq qa (getvar 'QAFLAGS))
(setvar 'QAFLAGS 1)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq dxf0 (dxf 0 e))
(cond
((= dxf0 "TEXT") (ssadd e kq))
(
(= dxf0 "INSERT")
(progn
(setq el (entlast))
(command "explode" ss "")

(while (setq en (entnext el))
(if (= (dxf 0 en) "TEXT") (ssadd en kq))
(setq el en)
)
)
)
)
)
(setvar 'QAFLAGS qa)
(ChangeLayer kq)
(princ "\nHochoaivandot - Cadviet.com")
(princ)
)

  • 2

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#34 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 06 November 2012 - 09:03 PM

em cám ơn anh HHVD nhiều lắm lsp chạy rất êm, em có like this mà hình như hôm nay em like this hơi nhiều nên forum hết cho like rùi hihi
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#35 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 13 December 2012 - 08:11 AM

tối qua bùn bùn, ngồi lục lại ổ cứng em đã tìm đc file chương trình có tác dụng giống mấy anh viết hộ em mà nó là file.exe, nhưng khác 1 cái giống lúc đầu em trình bày , ko cần biết nó thuộc layer nào, chỉ cần dạng giống file vd em đưa lên chọn đại 1 cái để tách là toàn bộ đối tượng giống vậy thuộc cùng 1 layer trong bản vẽ đều đc biến đổi có. Nay em mún nhờ mấy huynh xem hộ chương trình này có phải dựa trên nền tảng là lsp ko, em chỉ mún tìm hỉu thêm thui, chứ làm thì chắc phải chục năm mới làm nổi :D
http://www.cadviet.c..._tachnhan32.rar
em post lên nhờ mấy anh nghiên cứu, cách sử dụng nó như thế này
tạo 1 lệnh trong file acadxxx.lsp trong mục support của cad

(defun c:bbb ()
(startapp "TachNhan32")
)


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#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 13 December 2012 - 10:30 AM


(defun dxf (code e) (cdr (assoc code (entget e))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
)
(defun CreatLayer(MyLayer / MyColor)
(if (not (tblsearch "LAYER" MyLayer))
(progn
(entmakex
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 70 0)
(cons 2 MyLayer)
)
)
)
)
)
(defun ChangeLayer(kq / i dt type_dt)
(repeat (setq i (sslength kq))
(setq dt (ssname kq (setq i (1- i))))
(setq type_dt (type (read (dxf 1 dt))))
(cond
((= type_dt 'INT) (PUT-GC "SOTHUA" 8 dt))
((= type_dt 'REAL) (PUT-GC "DIENTICH" 8 dt))
((= type_dt 'SYM) (PUT-GC "LOAIRUONGDAT" 8 dt))
)
)
)
(defun c:test2 (/ ss el qa kq i)
(vl-load-com)
(CreatLayer "SOTHUA")
(CreatLayer "DIENTICH")
(CreatLayer "LOAIRUONGDAT")
(setq ss (ssget (list (cons 8 "13"))) kq (ssadd))
(setq qa (getvar 'QAFLAGS))
(setvar 'QAFLAGS 1)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq dxf0 (dxf 0 e))
(cond
((= dxf0 "TEXT") (ssadd e kq))
(
(= dxf0 "INSERT")
(progn
(setq el (entlast))
(command "explode" ss "")

(while (setq en (entnext el))
(if (= (dxf 0 en) "TEXT") (ssadd en kq))
(setq el en)
)
)
)
)
)
(setvar 'QAFLAGS qa)
(ChangeLayer kq)
(princ "\nHochoaivandot - Cadviet.com")
(princ)
)

Hề hề hề,...
Anh bạn này đổi nick được rồi đó. HOCHOAIHETHOT........
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#37 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 13 December 2012 - 12:20 PM

co anh nao giup em ko
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#38 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 13 December 2012 - 01:39 PM

co anh nao giup em ko

Hề hề hề,
Nó dựa trên cái gì thì phải hỏi người cho bạn cái file ấy, còn đã khóa tịt nó lại bằng cách đóng gói thành file exe rồi thì chỉ có tây mới biết bên trong nó là gì....
Hề hề hề.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#39 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 13 December 2012 - 03:50 PM

Anh Bình có thử chạy chưa anh, vậy nhìn cách nó chạy có thể suy ra đc ko anh, em quên là phải để file.exe đó trong thư mục support của cad nữa
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#40 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 December 2012 - 06:10 PM

Cái này quá đơn giản, nhoclangbat tự viết cũng được mà :o . Chú ý các lệnh Laymrg nữa thì công việc càng nhàn hơn. File exe viết bằng VB, k phải lisp
  • 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