Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
33 replies to this topic

#1 leejang

leejang

    biết lệnh move

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

Đã gửi 17 April 2011 - 05:11 AM

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

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 April 2011 - 09:29 AM

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

  • 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


#3 leejang

leejang

    biết lệnh move

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

Đã gửi 17 April 2011 - 10:21 AM

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

#4 leejang

leejang

    biết lệnh move

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

Đã gửi 17 April 2011 - 10:49 AM

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 ?


  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 April 2011 - 11:12 AM

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

  • 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


#6 leejang

leejang

    biết lệnh move

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

Đã gửi 17 April 2011 - 12:44 PM

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.c...s/3/vi_du_4.dwg
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 April 2011 - 01:31 PM

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

  • 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


#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 April 2011 - 01:33 PM

Srr,Mạng bị lỗi, bài update bên dưới ^^
  • 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


#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 April 2011 - 01:35 PM

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

  • 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


#10 leejang

leejang

    biết lệnh move

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

Đã gửi 18 April 2011 - 07:58 PM

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

#11 leejang

leejang

    biết lệnh move

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

Đã gửi 18 April 2011 - 08:11 PM

[quote name='leejang' date='18 April 2011 - 07:58 PM' timestamp='1303131488' post='141664']
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é !
  • 0

#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 April 2011 - 09:31 PM

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

  • 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


#13 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 April 2011 - 09:33 PM

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

  • 2

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


#14 leejang

leejang

    biết lệnh move

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

Đã gửi 19 April 2011 - 05:54 AM

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

#15 daik50

daik50

    biết vẽ point

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

Đã gửi 19 April 2011 - 08:09 AM

Sao bác không in theo nét trên layer
  • 0

#16 daik50

daik50

    biết vẽ point

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

Đã gửi 19 April 2011 - 08:10 AM

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

#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 19 April 2011 - 08:26 AM

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

  • 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


#18 leejang

leejang

    biết lệnh move

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

Đã gửi 19 April 2011 - 10:41 AM

[quote name='ketxu' date='19 April 2011 - 08:26 AM' timestamp='1303176396' post='141726']
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.
  • 0

#19 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 01 May 2011 - 07:32 PM

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

#20 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 May 2011 - 11:26 PM

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

  • 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