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

[Yêu cầu] lisp đổi màu tất cả các đường DIM ?

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

leejang    4

Đa số các bản vẽ là mình sửa các bản vẽ có sẵn, mà đường DIM khi in thì nên chọn nét mảnh cho đẹp bản vẽ, và trong một bản vẽ có rất nhiều kiểu Dim với các màu sắc khác nhau và có thể trùng với các màu cơ bản của đối tượng khác. Chính vì thế bài toán đặt ra là ta làm sao để các đường Dim đó có cùng một màu sắc đặc biệt và dễ dàng trong việc in ấn. VẬy các bác Pro có thể viết giúp em cái Lisp chuyển màu của các kiểu Dim có trong bản vẽ về màu 30, màu của text trong DIM là màu 02 được không ạ ? em cảm ơn các bác trướ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.652

Nếu bạn không đóng block dim thì có thể dùng cái này :)

(defun c:dc()(setvar "dimclrt" 2)(setvar "dimclrd" 30)(command "-dimstyle" "a" "all" ""))

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
leejang    4

Nếu bạn không đóng block dim thì có thể dùng cái này :)

(defun c:dc()(setvar "dimclrt" 2)(setvar "dimclrd" 30)(command "-dimstyle" "a" "all" ""))

Lisp đổi được màu DIM nhưng mà có 1 vấn đề phát sinh là nó tự động cắt cụt hết các chân DIM đi bác KETXU ạ ? Bác xem lại giúp em vớ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
leejang    4

Lisp đổi được màu DIM nhưng mà có 1 vấn đề phát sinh là nó tự động cắt cụt hết các chân DIM và màu đường gióng thì chưa thay đổi bác KETXU ạ !Bác xem lại giúp em vớ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
ketxu    2.652

Tự động cắt cút chận dim thì chắc là không có, chỉ thiếu cái chân dim chưa có màu 30 thôi :) Bạn sửa lại như vầy :

(defun c:dc()(setvar "dimclrt" 2)(setvar "dimclrd" 30)(setvar "dimclre" 30)(command "-dimstyle" "a" "all" ""))]

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
leejang    4

Tự động cắt cút chận dim thì chắc là không có, chỉ thiếu cái chân dim chưa có màu 30 thôi :) Bạn sửa lại như vầy :

(defun c:dc()(setvar "dimclrt" 2)(setvar "dimclrd" 30)(setvar "dimclre" 30)(command "-dimstyle" "a" "all" ""))]

Hic. Bác kiểm tra lại giúp em. Nó tự động CUT chân dim cụt hết đi mà ? Đây là file ví dụ, khi mở file mới thì nó đổi màu ko cut chân DIM, nhưng khi chạy trên file cũ thì nó cut hết chân dim ?

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

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

Do bạn dùng Dim override, nên sau khi dùng các lệnh dim update hay apply, nó đều lấy gốc nguyên thủy (chân dim bạn đang để có 2unit nên nhìn như bị cụt ^^)

Thôi đành không dùng lệnh của CAD nữa, chơi vlisp cho sang ^^. bạn dùng lại cái này :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION")))))))
(vla-put-Textcolor ent "2")
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

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

Do bạn dùng Dim override nên khi update dim, cad trả về nguyên thuỷ (gốc bạn để extendline có 2 unit, nên nhìn như bị chặt).

Thôi đành không dùng Cadcommand nữa, ta dùng Vlisp cho nó sang ^^. Bạn thay lại thằng này :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION")))))))
(vla-put-Textcolor ent "2")
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

  • 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
leejang    4

Do bạn dùng Dim override nên khi update dim, cad trả về nguyên thuỷ (gốc bạn để extendline có 2 unit, nên nhìn như bị chặt).

Thôi đành không dùng Cadcommand nữa, ta dùng Vlisp cho nó sang ^^. Bạn thay lại thằng này :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION")))))))
(vla-put-Textcolor ent "2")
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

ok. Em cảm ơn bác nhé !!! hihihi

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
leejang    4

ok. Em cảm ơn bác nhé nhưng còn một vấn đề là lisp chưa đổi màu đối tượng "LE", em xin lỗi là ko nhắc đến vấn đề này ngay từ đầu. BÁc chỉnh giúp e 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
ketxu    2.652

ok. Em cảm ơn bác nhé nhưng còn một vấn đề là lisp chưa đổi màu đối tượng "LE", em xin lỗi là ko nhắc đến vấn đề này ngay từ đầu. BÁc chỉnh giúp e nhé !

Bạn sửa lại như ày :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent "2")
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

  • 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
ketxu    2.652

Bạn sửa lại như sau :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent "2")
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

  • 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
leejang    4

Vâng, chuẩn không cần chỉnh anh à. E chẳng thấy nút Thanks ở chỗ nào mà vote cho a cả. hic !

Vâng, chuẩn không cần chỉnh anh à. Bi h a có thể tích hợp luôn vào lisp cái mục đổi màu tất cả các đối tượng hatch trong bản vẽ sang màu 9 được ko ạ ? Em bi h mới nghĩ ra, bởi vì hạtch luôn phải in nhạt ạ !

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
daik50    22

Bạn sửa lại như sau :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent "2")
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

 

Thanks bác phát, cái này rất 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
ketxu    2.652

Vâng, chuẩn không cần chỉnh anh à. Bi h a có thể tích hợp luôn vào lisp cái mục đổi màu tất cả các đối tượng hatch trong bản vẽ sang màu 9 được ko ạ ? Em bi h mới nghĩ ra, bởi vì hạtch luôn phải in nhạt ạ !

Hatch thì dùng thêm phần command cũng được. Lưu ý với bạn là mình chưa động tới các đối tượng trong block nhé :)

(defun C:dc() 
(vl-load-com) 
(foreach ent 
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER"))))))) 
(if (vlax-property-available-p ent 'TextColor) (vla-put-Textcolor ent "2") ) 
(if (vlax-property-available-p ent 'DimensionLinecolor) (vla-put-DimensionLinecolor ent "30") ) 
(if (vlax-property-available-p ent 'ExtensionLinecolor) (vla-put-ExtensionLinecolor ent "30") ) ) 
(command ".change" (ssget "X" '((0 . "Hatch"))) "" "p" "c" 9 "")
)

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
leejang    4

Hatch thì dùng thêm phần command cũng được. Lưu ý với bạn là mình chưa động tới các đối tượng trong block nhé :)

(defun C:dc() 
(vl-load-com) 
(foreach ent 
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER"))))))) 
(if (vlax-property-available-p ent 'TextColor) (vla-put-Textcolor ent "2") ) 
(if (vlax-property-available-p ent 'DimensionLinecolor) (vla-put-DimensionLinecolor ent "30") ) 
(if (vlax-property-available-p ent 'ExtensionLinecolor) (vla-put-ExtensionLinecolor ent "30") ) ) 
(command ".change" (ssget "X" '((0 . "Hatch"))) "" "p" "c" 9 "")
)

 

Thanks bác nhé . Ok rồi ạ, nhưng khi nào bác có thời gian bác hoàn thiện lisp hơn là các đối tượng bên trong Blog cũng bị đổi màu. Như thế thì tiện hơn nhiều đấy ạ ? Lisp này sẽ giúp cho việc in ấn nhanh hơn rất nhiều đối với các bản vẽ phức tạp có nhiều layer.

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
Phiphi-    175

Bạn sửa lại như ày :

(defun C:dc()
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent "2")
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent "30")
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent "30")
)
)
)

Xin Bác Ketxu viêt thêm multilearder vào Lisp trên. 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.652

Xin Bác Ketxu viêt thêm multilearder vào Lisp trên. Thanks

Thằng Mleader nó lại chẳng giống ai nhỉ ^^. bạn sửa lại như vầy (tách ra cho dễ)

(defun C:dc()
(vl-load-com)
(setq txtcol 2 lcol 30) 
(setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.17"))   
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent txtcol)
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent lcol)
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent lcol)
)

)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "MULTILEADER")))))))    
   (vla-put-ColorIndex colorObj ldrcol) 
   (vla-put-LeaderLineColor ent colorObj)
    (vla-put-ColorIndex colorObj txtcol) 
   (vla-put-TrueColor ent colorObj)
)
)

  • 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
leejang    4

Thằng Mleader nó lại chẳng giống ai nhỉ ^^. bạn sửa lại như vầy (tách ra cho dễ)

(defun C:dc()
(vl-load-com)
(setq txtcol 2 lcol 30) 
(setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.17"))   
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent txtcol)
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent lcol)
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent lcol)
)

)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "MULTILEADER")))))))    
   (vla-put-ColorIndex colorObj ldrcol) 
   (vla-put-LeaderLineColor ent colorObj)
    (vla-put-ColorIndex colorObj txtcol) 
   (vla-put-TrueColor ent colorObj)
)
)

 

 

Bác xem lại giúp em cái. E tải về chạy thì được báo lỗi sau :

Command: dc

error: Automation Error. Problem in loading application

  • Vote giảm 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
ketxu    2.652

Bạn đang dùng CAD Ver mấy nhỉ ?

Bạn thử dùng cái nyaf xem còn lỗi k

(defun C:dc()
(vl-load-com)
(setq txtcol 2 lcol 30) 
(setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))))   
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent txtcol)
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent lcol)
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent lcol)
)

)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "MULTILEADER")))))))    
   (vla-put-ColorIndex colorObj ldrcol) 
   (vla-put-LeaderLineColor ent colorObj)
    (vla-put-ColorIndex colorObj txtcol) 
   (vla-put-TrueColor ent colorObj)
)
)

  • Vote giảm 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
leejang    4

Thằng Mleader nó lại chẳng giống ai nhỉ ^^. bạn sửa lại như vầy (tách ra cho dễ)

(defun C:dc()
(vl-load-com)
(setq txtcol 2 lcol 30) 
(setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.17"))   
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "DIMENSION,LEADER")))))))
(if (vlax-property-available-p ent 'TextColor)
(vla-put-Textcolor ent txtcol)
)
(if (vlax-property-available-p ent 'DimensionLinecolor)
(vla-put-DimensionLinecolor ent lcol)
)
(if (vlax-property-available-p ent 'ExtensionLinecolor)
(vla-put-ExtensionLinecolor ent lcol)
)

)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "MULTILEADER")))))))    
   (vla-put-ColorIndex colorObj ldrcol) 
   (vla-put-LeaderLineColor ent colorObj)
    (vla-put-ColorIndex colorObj txtcol) 
   (vla-put-TrueColor ent colorObj)
)
)

 

Khi chạy thì e nhận được thông báo lỗi như sau :

Command: dc

error: Automation Error. Problem in loading application

  • Vote giảm 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

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


×