Nhờ viết lisp dọn mặt bằng siêu tốc

Tháng 2 21, 2011

Gửi các anh chị trong diễn đàn.

Công việc dọn mặt bằng kiến trúc để làm nền vẽ rất nhàm chán và mất thời gian.

Vì vậy em nhờ các cao thủ viết hộ lisp dọn mặt bằng với nội dung như sau:

- Tạo ra layer: Architech với color = 8, linetype= continuous

- Chuyển insertion scale về millimeters

- Chuyển tất cả các layer trong bản vẽ về layer Architech nhưng giữ nguyên thuộc tính của các đối tượng (để cho các đường center, hidden ko bị biến thành continuous).

Cám ơn các anh chị trước

Em Hoàng

Tháng 2 21, 2011

Gửi các anh chị trong diễn đàn.

Công việc dọn mặt bằng kiến trúc để làm nền vẽ rất nhàm chán và mất thời gian.

Vì vậy em nhờ các cao thủ viết hộ lisp dọn mặt bằng với nội dung như sau:

- Tạo ra layer: Architech với color = 8, linetype= continuous

- Chuyển insertion scale về millimeters

- Chuyển tất cả các layer trong bản vẽ về layer Architech nhưng giữ nguyên thuộc tính của các đối tượng (để cho các đường center, hidden ko bị biến thành continuous).

Cám ơn các anh chị trước

Em Hoàng

Của bạn đây

(defun c:don(/ ss)
 (if (= (tblsearch "layer" "architect") nil)
   (command "layer" "m" "architect" "c" "8" "" "l" "continuous" "" "")
   )
 (setq ss (ssget)
ssl (acet-ss-to-list ss)
)
 (foreach n ssl
   (command "chprop" n "" "la" "architect" "")
 )
 )

Tháng 2 21, 2011

Gửi bạn Tú,

Mình đã test thử và thấy tương đối chuẩn. Bạn thử chỉnh sửa lại code theo hướng sau giúp mình xem có được không nhé:

- Tất cả các màu về bylayer của lớp architech (để khi in mình set color 8 cho những phần thuộc kiến trúc chìm xuống)

- Chỉ giữ lại linetype của các đối tượng thôi

- Bạn bổ sung vào lsp cho mình lệnh để làm cho units to scale inserted content có đơn vị là milimeter (thông thường phải dùng lệnh units rồi chọn ở mục Insertion scale) để khi xref đối tượng ko bị phóng to.

Cám ơn bạn nhiều

Tháng 2 21, 2011

Gửi các anh chị trong diễn đàn.

Công việc dọn mặt bằng kiến trúc để làm nền vẽ rất nhàm chán và mất thời gian.

Vì vậy em nhờ các cao thủ viết hộ lisp dọn mặt bằng với nội dung như sau:

- Tạo ra layer: Architech với color = 8, linetype= continuous

- Chuyển insertion scale về millimeters

- Chuyển tất cả các layer trong bản vẽ về layer Architech nhưng giữ nguyên thuộc tính của các đối tượng (để cho các đường center, hidden ko bị biến thành continuous).

Cám ơn các anh chị trước

Em Hoàng

Bạn xài thử cái này coi đã đúng ý chưa và cần bổ sung gì nhé. Chúc bạn vui.

(defun c:chla (/ nla ss n i lst ent la lsol m k)
(setq nla  "Architech")
(if (not (tblsearch "layer" nla))
(command "layer" "n" nla "c" "8" nla "lt" "continuous" nla "")
)
(setq ss (ssget)
     n (sslength ss)
     i 0 )
(while (< i n)
(setq ent (ssname ss i)
     lst (entget ent))
(setq la (cdr (assoc 8 lst)))
(setq lsol (tblsearch "layer" la))

(if (= (assoc 6 lst) nil)
(progn
(setq k (cdr(assoc 6 lsol)))
(setq lst (append lst (list (cons 6 k))))
(entmod lst)
)
)
(setq i (1+ i))
)
(command "change" ss "" "p" "la" nla "c" "8" "")
(setvar "INSUNITS" 4)
(setvar "INSUNITSDEFSOURCE" 4)
(setvar "INSUNITSDEFTARGET" 4)
(princ)
)

Tháng 2 21, 2011

Gửi bạn Bình,

Mình đã test thử và tốc độ chạy tương đối rất ấn tượng. Bạn thử chỉnh sửa lại code theo hướng sau giúp mình xem có được không nhé:

- Tất cả các màu về bylayer của lớp architech (để khi in mình set color 8 cho những phần thuộc kiến trúc chìm xuống)

- Chỉ giữ lại linetype của các đối tượng thôi

- Bạn bổ sung vào lsp cho mình lệnh để làm cho units to scale inserted content có đơn vị là milimeter (thông thường phải dùng lệnh units rồi chọn ở mục Insertion scale) để khi xref đối tượng ko bị phóng to.

Cám ơn bạn nhiều

Tháng 2 21, 2011

Gửi bạn Bình,

Mình đã test thử và tốc độ chạy tương đối rất ấn tượng. Bạn thử chỉnh sửa lại code theo hướng sau giúp mình xem có được không nhé:

- Tất cả các màu về bylayer của lớp architech (để khi in mình set color 8 cho những phần thuộc kiến trúc chìm xuống)

- Chỉ giữ lại linetype của các đối tượng thôi

- Bạn bổ sung vào lsp cho mình lệnh để làm cho units to scale inserted content có đơn vị là milimeter (thông thường phải dùng lệnh units rồi chọn ở mục Insertion scale) để khi xref đối tượng ko bị phóng to.

Cám ơn bạn nhiều

Mình đã bổ sung những điều bạn cần vào lisp phía trên, bạn hãy kiểm tra lại xem nhé.

Tháng 2 21, 2011

Gửi bạn Bình,

Lisp của bạn rất tuyệt, nó chỉ vướng 1 chút với block và dim. Cụ thể đối với block/dim mà màu ko phải là bylayer (ví dụ màu đỏ) thì nó vẫn kết quả sau khi chạy nó vẫn màu đỏ.

Bạn thử chỉnh sửa lại xem nhé

Hoàng

Tháng 2 21, 2011

Gửi bạn Bình,

Lisp của bạn rất tuyệt, nó chỉ vướng 1 chút với block và dim. Cụ thể đối với block/dim mà màu ko phải là bylayer (ví dụ màu đỏ) thì nó vẫn kết quả sau khi chạy nó vẫn màu đỏ.

Bạn thử chỉnh sửa lại xem nhé

Hoàng

Với các đối tượng là block và dim, việc hiệu chỉnh các đối tượng phần tử con của nó cần phải lấy được các mã dxf của chúng. Do vậy bạn có thể gửi một bản vẽ có chứa các đối tượng này để mình test được không??? Các đối tượng block lại có thể chứa các block con bên trong nó nên việc giải quyết cho triệt để là không đơn giản, bạn hãy ráng chờ nhé.....

Tháng 2 21, 2011

Gửi bạn Bình,

Cám ơn sự nhiệt tình của bạn. Thông thuờng thì chỉ có block 1 lần chứ ko có block con.

Mình gửi file để bạn tham khảo.

http://www.cadviet.com/upfiles/3/file_minh_hoa_don_mat_bang.dwg

Cố gắng giúp mình nhé.

Hoàng

Tháng 2 23, 2011

Gửi bạn Bình,

Cám ơn sự nhiệt tình của bạn. Thông thuờng thì chỉ có block 1 lần chứ ko có block con.

Mình gửi file để bạn tham khảo.

http://www.cadviet.com/upfiles/3/file_minh_hoa_don_mat_bang.dwg

Cố gắng giúp mình nhé.

Hoàng

Bạn dùng thử cái này coi sao. Với các dim mình chưa giải quyết do chưa hiểu hết, cần tìm hiểu thêm. Với các block, mặc dù mình đã sử dụng phép đệ quy nhưng không hiểu vì sao vẫn chưa triệt để được. Có lẽ các block của bạn còn phức tạp hơn cái mình nghĩ chăng. Hy vọng nó sẽ giúp bạn được phần nào trong công việc.

(defun c:chla (/ nla ss n i lst ent la lsol m k)
(setq nla  "Architech")
(if (not (tblsearch "layer" nla))
(command "layer" "n" nla "c" "8" nla "lt" "continuous" nla "")
)
(setq ss (ssget)
     n (sslength ss)
     i 0 )
(while (< i n)
(setq ent (ssname ss i)
     lst (entget ent))
(setq la (cdr (assoc 8 lst)))
(setq lsol (tblsearch "layer" la))
(if (= (cdr (assoc 0 lst)) "INSERT")
  (progn
       ;;;;;;;;;;;(setq bln (cdr (assoc 2 lst)))
       (chbl ent)
    )
)

(if (= (assoc 6 lst) nil)
(progn
(setq k (cdr(assoc 6 lsol)))
(setq lst (append lst (list (cons 6 k))))
(entmod lst)
)
)
(setq i (1+ i))
)
(command "change" ss "" "p" "la" nla "c" "8" "")
(setvar "INSUNITS" 4)
(setvar "INSUNITSDEFSOURCE" 4)
(setvar "INSUNITSDEFTARGET" 4)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chbl ( blk / bln en els )
(setq bln (cdr (assoc 2 (entget blk))))
(setq en (cdr (assoc -2 (tblsearch "block" bln ))))
(while (/= en nil)
        (setq els (entget en))
        (if (= (cdr (assoc 0 els)) "INSERT")
           (progn 
                   ;;;;;;;;;(setq bln (cdr (assoc 2 els)))
                   (chbl en)
           )
           (progn

              (if (/= (assoc 62 els) nil)
                 (setq els (subst (cons 62 8) (assoc 62 els) els))
                 (setq els (append (list (cons 62 8)) els))
              )
              (entmod els)
              (entupd en)
          )
       ) 
       (setq en (entnext en))
)
)

Có gì cần bổ sung bạn cứ nói nhé. Phần về dim mình sẽ bổ sung sau khi ngâm cứu ra.

Tháng 2 23, 2011

Gửi bạn Bình,

Cám ơn bạn nhiều. Đối với mình thế này là ổn lắm rồi. Mình vừa tìm trong diễn đàn có lisp change colour dùng để đổi màu tất cả vật thể trong bản vẽ về 1 màu, mình sẽ sử dụng phối hợp với lisp chla của bạn là ok. Cái hay của lisp chla là làm nhẹ bản vẽ đi rất nhiều vì chỉ có 1 layer architech hơn là chỉ sử dụng lisp change colour độc lập.

Hoàng

Tháng 2 24, 2011

Gửi bạn Bình,

Cám ơn bạn nhiều. Đối với mình thế này là ổn lắm rồi. Mình vừa tìm trong diễn đàn có lisp change colour dùng để đổi màu tất cả vật thể trong bản vẽ về 1 màu, mình sẽ sử dụng phối hợp với lisp chla của bạn là ok. Cái hay của lisp chla là làm nhẹ bản vẽ đi rất nhiều vì chỉ có 1 layer architech hơn là chỉ sử dụng lisp change colour độc lập.

Hoàng

Chaò bạn Hoàng,

Bạn có thể gửi cho mình cái lisp change colour để mình tham khảo hay không vì mình vẫn lúng túng trong việc chuyển màu của các đối tượng Dim mà không phải phá nó ra bạn ạ. Rất mong bạn giúp đỡ.

Tháng 2 24, 2011

Chaò bạn Hoàng,

Bạn có thể gửi cho mình cái lisp change colour để mình tham khảo hay không vì mình vẫn lúng túng trong việc chuyển màu của các đối tượng Dim mà không phải phá nó ra bạn ạ. Rất mong bạn giúp đỡ.

Chào bác Bình.

Khi phá Dim ra thì Dim đâu còn là dim nữa bác?

Chuyển màu của các đối tượng Dim là chuyển Dim về cùng 1 màu duy nhất?

Hay là em đã hiểu sai?

Chúc bác luôn khoẻ

Tháng 2 24, 2011

Chaò bạn Hoàng,

Bạn có thể gửi cho mình cái lisp change colour để mình tham khảo hay không vì mình vẫn lúng túng trong việc chuyển màu của các đối tượng Dim mà không phải phá nó ra bạn ạ. Rất mong bạn giúp đỡ.

Chào bác Bình.

Thông thuờng, Cad quản lý màu của Dim trong DimStyle (ngoại trừ Override).

Do đó muốn chuyển màu của các đối tượng Dim mà không phải phá nó ra thì phải định nghĩa lại DimStyle. <_<

(Tưong tự như với Block, phải Edit lại block)

Tháng 2 24, 2011

Gửi bạn Bình,

Cám ơn bạn nhiều. Đối với mình thế này là ổn lắm rồi. Mình vừa tìm trong diễn đàn có lisp change colour dùng để đổi màu tất cả vật thể trong bản vẽ về 1 màu, mình sẽ sử dụng phối hợp với lisp chla của bạn là ok. Cái hay của lisp chla là làm nhẹ bản vẽ đi rất nhiều vì chỉ có 1 layer architech hơn là chỉ sử dụng lisp change colour độc lập.

Hoàng

Gửi bạn cái lisp dùng để chuyển các đối tượng Dim trên bản vẽ về cùng lớp Architech và có màu là 8. Việc ghép lisp này với lisp trước mình chưa làm được nên bạn có thể nghiên cứu để tự ghép hoặc dùng kết hợp (phải gõ hai lệnh lisp).

(defun c:chdim (/ nla ss n i ent lst bl e1 el1 )
(setq nla  "Architech")
(if (not (tblsearch "layer" nla))
(command "layer" "n" nla "c" "8" nla "lt" "continuous" nla "")
)
(setq ss (ssget (list (cons 0 "DIMENSION")))
     n (sslength ss)
     i 0 )
(while (< i n)
        (setq ent (ssname ss i)
                lst (entget ent))         
         (setq bl (cdr (assoc 2 lst)) 
                 e1 (cdr (assoc -2 (tblsearch "block" bl )))
         )
         (setq lst (subst (cons 8 "Architech") (assoc 8 lst) lst))
         (entmod lst)
         (while e1
                  (setq el1 (entget e1))
                  (if (= (cdr (assoc 0 el1)) "INSERT")
                      (chbl e1)
                  )
                  (if (= (assoc 62 el1) nil)
                      (setq el1 (append (list (cons 62 8)) el1))
                      (setq el1 (subst (cons 62 8) (assoc 62 el1) el1))
                  )
                  (setq el1 (subst (cons 8 "Architech") (assoc 8 el1) el1))
                  (entmod el1)                                                      
                  (setq e1 (entnext e1))
         )                                      
         (setq i (1+ i))
)
(command "regenall" )
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chbl ( blk / bln en els )
(setq bln (cdr (assoc 2 (entget blk))))
(setq en (cdr (assoc -2 (tblsearch "block" bln ))))
(while (/= en nil)
        (setq els (entget en))
        (if (= (cdr (assoc 0 els)) "INSERT")
           (progn 
                   ;;;;;;;;;(setq bln (cdr (assoc 2 els)))
                   (chbl en)
           )
           (progn

              (if (/= (assoc 62 els) nil)
                 (setq els (subst (cons 62 8) (assoc 62 els) els))
                 (setq els (append (list (cons 62 8)) els))
              )
              (entmod els)
              (entupd en)
          )
       ) 
       (setq en (entnext en))
)
)

Chúc bạn vui.

Chỉnh sửa Tháng 2 25, 2011 theo phamthanhbinh
Bổ sung theo góp ý của bác Ketxu

Tháng 2 24, 2011

Chào bác Bình.

Thông thuờng, Cad quản lý màu của Dim trong DimStyle (ngoại trừ Override).

Do đó muốn chuyển màu của các đối tượng Dim mà không phải phá nó ra thì phải định nghĩa lại DimStyle. <_<

(Tưong tự như với Block, phải Edit lại block)

Chào bác Gia_bach,

Việc chuyển màu của các đối tượng dim mình giải quyết bằng cách mò vào cái block chứa các đối tượng con của dim, nó có tên được xác định bằng mã dxf 2 của Dim. Bác có thể xem qua cái lisp phía trên của mình để rõ hơn vì mình nói có thể không gãy gọn lắm.

Như vậy sau khi chuyển cái Dim vẫn giữ nguyên các thuộc tính như cũ bác ạ.

@Bác Tue_NV: Việc chuyển màu của các đối tượng Dim có thể hiểu như bác nhưng cũng có thể không bác ạ. Vấn đề là do đối tượng Dim là đối tượng phức hợp gồm nhiều đối tượng con mà mỗi đối tượng con này lại có thể chứa các màu khác nhau. (Mặc dù chúng có chung một lớp). Theo yêu cầu của bạn Hoàng phải chuyển tất cả các dim về cùng lớp Architech và lại phải có màu cùng với màu của lớp Architech là màu 8. Vậy nên phải đổi tất cả màu của các đối tượng con có trong các Dim bác ạ.

Mình đã loay hoay đổi được bằng cái lisp phía trên, nhưng khi ghép nó với cái lisp trước thì nó lại chạy tung hoăng mà chửa biết tại sao nên đành để thành hai lisp như vầy.

Nếu bác nào ghép hộ thành một lisp chạy ngon thì tốt quá.

Thực tế chạy thử thì cái lisp thứ nhất vẫn chưa được ngon nhưng mình cũng chưa biết lỗi do đâu. Mặc dù đã dùng phép đệ quy mà sao vẫn cứ còn sót một số đối tượng con trên bản vẽ. Rất mong các bác sửa giúp....

Tháng 2 24, 2011

E vừa chạy thử chdim của bác, thấy dim dù đã chuyển màu nhưng layer vẫn nguyên bác ạ ^^

Tháng 2 24, 2011

@bạn Hoàng và bác Bình : bác test thử xem sao.Em có thêm cả phần Leader nữa, vì trong bản vẽ của bạn ý có cả Leader

;free lisp from cadviet.com @ ketxu
(defun c:clear(/ nla)
(vl-load-com)
(command "undo" "be")
(setvar "cmdecho" 0)
(setq nla  "Architech")
(if (not (tblsearch "layer" nla))(command "layer" "n" nla "c" "8" nla "lt" "continuous" nla ""))
(setvar "clayer" nla)

(command "change" (ssget "X") "" "p" "la" nla "c" "8" "")
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
 (vlax-for block (vla-get-blocks adoc) 
   (if   (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
     (vlax-for   ent block 
	(progn
		(vla-put-color ent "8")
		(vla-put-layer ent "Architech")
	)    
   ) 
    ) 
  )
(acet-sysvar-set (list "dimclrt" 256 "dimclre" 256 "dimclrd" 256 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(princ))

Tháng 2 25, 2011

Gửi bạn ketxu,

Mình đã test thử, chuẩn ko cần chỉnh. Cám ơn bạn nhiều

Hoàng

Tháng 2 25, 2011

E vừa chạy thử chdim của bác, thấy dim dù đã chuyển màu nhưng layer vẫn nguyên bác ạ ^^

Hề hề hề,

Chào bác Ketxu,

Xin lỗi vì mình không kiểm tra lại, thực tế thì các phần tử con đã được chuyển hết về lớp "Architech", nhưng còn nguyên thằng block thì vẫn ở lớp cũ là "dim-line". Mình đã bổ sung thêm code chuyển thằng này về lớp "Architech" rồi. Bác xem lại nhé....

Chúc bác luôn vui vẻ và yêu đời.....

Tháng 2 25, 2011

Hì, vâng, đã ổn phần Dim rồi bác ạ :">

Tháng 3 11, 2011

Bạn ketxu ơi lisp clear của bạn khá ổn nhưng nó xóa hết tất cả các layer rồi, có cách nào chỉ chuyển sang màu 8 mà ko del các layer (giống lisp colorx, lisp colorx thì hay lỗi phông tiếng việt :().

Mình ko tìm thây layer depoin và layer text và dim của kiến trúc để làm việc cả.

thanks

Tháng 3 11, 2011

Bạn ketxu ơi lisp clear của bạn khá ổn nhưng nó xóa hết tất cả các layer rồi, có cách nào chỉ chuyển sang màu 8 mà ko del các layer (giống lisp colorx, lisp colorx thì hay lỗi phông tiếng việt :().

Mình ko tìm thây layer depoin và layer text và dim của kiến trúc để làm việc cả.

thanks

Tất nhiên là được bạn. Bản bên này là bản chưa fix với block att. Bản bên kia fix rồi, bạn post bên đó nhé.

Muốn không đổi layer thì cứ đoạn nào có put layer.. thì bạn xoá đi. Xoá cả dòng command change la đi ^^

http://www.cadviet.com/forum/index.php?showtopic=35594&st=0&p=133307&fromsearch=1&&do=findComment&comment=133307

Tháng 3 19, 2011

sao em không load được lisp clear nhi? :rolleyes:

Bạn reply bài viết của mình để lấy code hoặc down link

Clear

Tháng 3 21, 2011

Bạn reply bài viết của mình để lấy code hoặc down link

Clear

[/qu

em muốn giữ lại layer nhưng e làm theo đúng lời bác mà vẫn ko được.

bac có thể sửa không.thank bác nhiều

Đăng nhập

Nhờ viết lisp dọn mặt bằng siêu tốc

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

hoangtdh 8

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

phamngoctukts 714

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

hoangtdh 8

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

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

hoangtdh 8

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

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

hoangtdh 8

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

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

hoangtdh 8

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

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

hoangtdh 8

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

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

Tue_NV 3.912

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

gia_bach 1.551

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

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

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

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

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

hoangtdh 8

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