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

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

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

hoangtdh    8

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

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    708

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

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

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

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

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

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

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

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

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

  • 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
hoangtdh    8

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

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

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

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

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

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

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.

  • 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
hoangtdh    8

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

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

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 đỡ.

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

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ẻ

  • 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
gia_bach    1.442

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)

  • 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
phamthanhbinh    3.123

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 theo phamthanhbinh
Bổ sung theo góp ý của bác Ketxu

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

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

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

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 ạ ^^

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

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

  • 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
phamthanhbinh    3.123

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

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
duyhung    9

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

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

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

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

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

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


×