Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] Đổi màu cho đối tượng


  • Please log in to reply
9 replies to this topic

#1 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 03 August 2011 - 12:42 PM

Em có đoạn lisp:
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=880
(defun c:mtl(/ doc Util MS c1 c2 kc2tl L1 oldos i j p dgiao pc2)
(vl-load-com)
(setq doc (vla-get-activeDocument (vlax-get-acad-object))
Util (vla-get-utility doc)
MS (vla-get-ModelSpace doc))
(vla-StartUndoMark doc)
(setq c1 (car(entsel "\n Chon duong bien thu nhat :")))
(setq c2 (car(entsel "\n Chon duong bien thu hai :")))
(if (not *kc2tl*) (setq *kc2tl* 2))
(setq kc2tl (getdist (strcat "\n Khoang cach giua taluy ngan va taluy dai < "
(rtos *kc2tl* 2 2) " > : "
)
)
)
(if (not kc2tl) (setq kc2tl *kc2tl*) (setq *kc2tl* kc2tl))
(setq L1 (vlax-curve-getDistAtParam c1
(setq pre (vlax-curve-getEndParam c1))
)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq i 0 j 0)
(Repeat (1+ (fix (/ L1 kc2tl)))
(setq p (vlax-curve-getPointAtDist c1 i))
(setq dgiao (vlax-curve-getClosestPointTo c2 p nil))
(if (= (rem j 2) 0)
(setq pc2 dgiao)
(setq pc2 (list (/ (+ (car p) (car dgiao)) 2) (/ (+ (cadr p) (cadr dgiao)) 2) 0))
)
(vla-addline MS (vlax-3d-point p)
(vlax-3d-point pc2)
)
(setq i (+ i kc2tl))
(setq j (1+ j))
(command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
;(princ)
);repeat
(setvar "osmode" oldos)
(vla-EndUndoMark doc)
(princ)
)
Em đã thêm đoạn code: (command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
để đổi màu đối tượng sang màu 8.Nhưng khi chạy lisp thì tương đối lâu so với khi không đổi màu.
Các bác có thể chỉnh sửa giúp em cho lisp chạy nhanh hơn không.Theo em nghĩ mình chỉ cần tạo list đối tượn sau khi lặp xong rồi đổi màu có lẽ nhanh hơn? Vì em không thạo hàm vla- lắm. Nên không biết sửa thế nào.
Mong các bác chỉ giúp cho lisp chạy nhanh hơn!
Cám ơn!
  • 0

#2 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 03 August 2011 - 01:04 PM

Em có đoạn lisp:

Em đã thêm đoạn code: (command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
để đổi màu đối tượng sang màu 8.Nhưng khi chạy lisp thì tương đối lâu so với khi không đổi màu.
Các bác có thể chỉnh sửa giúp em cho lisp chạy nhanh hơn không.Theo em nghĩ mình chỉ cần tạo list đối tượn sau khi lặp xong rồi đổi màu có lẽ nhanh hơn? Vì em không thạo hàm vla- lắm. Nên không biết sửa thế nào.
Mong các bác chỉ giúp cho lisp chạy nhanh hơn!
Cám ơn!

Hề hề hề.
Làm thử thế này có nhanh hơn không nhé:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=880
(defun c:mtl(/ doc Util MS c1 c2 kc2tl L1 oldos i j p dgiao pc2)
(vl-load-com)
(setq oldco (getvar "cecolor"))
(setq doc (vla-get-activeDocument (vlax-get-acad-object))
Util (vla-get-utility doc)
MS (vla-get-ModelSpace doc))
(vla-StartUndoMark doc)
(setq c1 (car(entsel "\n Chon duong bien thu nhat :")))
(setq c2 (car(entsel "\n Chon duong bien thu hai :")))
(if (not *kc2tl*) (setq *kc2tl* 2))
(setq kc2tl (getdist (strcat "\n Khoang cach giua taluy ngan va taluy dai < "
(rtos *kc2tl* 2 2) " > : "
)
)
)
(if (not kc2tl) (setq kc2tl *kc2tl*) (setq *kc2tl* kc2tl))
(setq L1 (vlax-curve-getDistAtParam c1
(setq pre (vlax-curve-getEndParam c1))
)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cecolor" "8")
(setq i 0 j 0)
(Repeat (1+ (fix (/ L1 kc2tl)))
(setq p (vlax-curve-getPointAtDist c1 i))
(setq dgiao (vlax-curve-getClosestPointTo c2 p nil))
(if (= (rem j 2) 0)
(setq pc2 dgiao)
(setq pc2 (list (/ (+ (car p) (car dgiao)) 2) (/ (+ (cadr p) (cadr dgiao)) 2) 0))
)
(vla-addline MS (vlax-3d-point p)
(vlax-3d-point pc2)
)
(setq i (+ i kc2tl))
(setq j (1+ j))
;;;;;;;;;;(command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
;(princ)
);repeat
(setvar "osmode" oldos)
(setvar "cecolor" oldco)
(vla-EndUndoMark doc)
(princ)
)

Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 03 August 2011 - 01:46 PM

Hề hề hề.
Làm thử thế này có nhanh hơn không nhé:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=880
(defun c:mtl(/ doc Util MS c1 c2 kc2tl L1 oldos i j p dgiao pc2)
(vl-load-com)
(setq oldco (getvar "cecolor"))
(setq doc (vla-get-activeDocument (vlax-get-acad-object))
Util (vla-get-utility doc)
MS (vla-get-ModelSpace doc))
(vla-StartUndoMark doc)
(setq c1 (car(entsel "\n Chon duong bien thu nhat :")))
(setq c2 (car(entsel "\n Chon duong bien thu hai :")))
(if (not *kc2tl*) (setq *kc2tl* 2))
(setq kc2tl (getdist (strcat "\n Khoang cach giua taluy ngan va taluy dai < "
(rtos *kc2tl* 2 2) " > : "
)
)
)
(if (not kc2tl) (setq kc2tl *kc2tl*) (setq *kc2tl* kc2tl))
(setq L1 (vlax-curve-getDistAtParam c1
(setq pre (vlax-curve-getEndParam c1))
)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cecolor" "8")
(setq i 0 j 0)
(Repeat (1+ (fix (/ L1 kc2tl)))
(setq p (vlax-curve-getPointAtDist c1 i))
(setq dgiao (vlax-curve-getClosestPointTo c2 p nil))
(if (= (rem j 2) 0)
(setq pc2 dgiao)
(setq pc2 (list (/ (+ (car p) (car dgiao)) 2) (/ (+ (cadr p) (cadr dgiao)) 2) 0))
)
(vla-addline MS (vlax-3d-point p)
(vlax-3d-point pc2)
)
(setq i (+ i kc2tl))
(setq j (1+ j))
;;;;;;;;;;(command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
;(princ)
);repeat
(setvar "osmode" oldos)
(setvar "cecolor" oldco)
(vla-EndUndoMark doc)
(princ)
)

Chúc bạn vui.

Ok. Đã test thanh bạn nhiều :D.Nếu muốn tạo lớp mới: "ghi chu" cho đối tượng được tạo ra làm như nào nhỉ ?
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 03 August 2011 - 01:54 PM

Mình đã đổi tên topic cho phù hợp. Hy vọng bạn NguyenNgocSon không phiền và rút kinh nghiệm nhé. Nội quy dưới chữ ký của mình có link tới !
  • 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


#5 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 03 August 2011 - 02:02 PM

Ok. Đã test thanh bạn nhiều :D.Nếu muốn tạo lớp mới: "ghi chu" cho đối tượng được tạo ra làm như nào nhỉ ?

Hề hề hề,
bạn tham khảo đoạn code tạo lớp sau của bác ketxu nhé:
(if (not (tblsearch "layer" "daimoc"))
(command "-LAYER" "m" "daimoc" "c" 1 "daimoc" "")
)
Đoạn lisp trên kiểm tra xem trên bản vẽ đã có layer daimoc chưa, nếu chưa thì tạo layer daimoc mới vớ thuộc tính màu là 1 (đỏ).
Nếu bạn muốn thêm các thuộc tính khác thì cứ thế mà tiếp tục, bổ sung vào cuối lisp.
hề hề hề,...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 03 August 2011 - 02:22 PM

Hề hề hề.
Làm thử thế này có nhanh hơn không nhé:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=880
(defun c:mtl(/ doc Util MS c1 c2 kc2tl L1 oldos i j p dgiao pc2)
(vl-load-com)
(setq oldco (getvar "cecolor"))
(setq doc (vla-get-activeDocument (vlax-get-acad-object))
Util (vla-get-utility doc)
MS (vla-get-ModelSpace doc))
(vla-StartUndoMark doc)
(setq c1 (car(entsel "\n Chon duong bien thu nhat :")))
(setq c2 (car(entsel "\n Chon duong bien thu hai :")))
(if (not *kc2tl*) (setq *kc2tl* 2))
(setq kc2tl (getdist (strcat "\n Khoang cach giua taluy ngan va taluy dai < "
(rtos *kc2tl* 2 2) " > : "
)
)
)
(if (not kc2tl) (setq kc2tl *kc2tl*) (setq *kc2tl* kc2tl))
(setq L1 (vlax-curve-getDistAtParam c1
(setq pre (vlax-curve-getEndParam c1))
)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cecolor" "8")
(setq i 0 j 0)
(Repeat (1+ (fix (/ L1 kc2tl)))
(setq p (vlax-curve-getPointAtDist c1 i))
(setq dgiao (vlax-curve-getClosestPointTo c2 p nil))
(if (= (rem j 2) 0)
(setq pc2 dgiao)
(setq pc2 (list (/ (+ (car p) (car dgiao)) 2) (/ (+ (cadr p) (cadr dgiao)) 2) 0))
)
(vla-addline MS (vlax-3d-point p)
(vlax-3d-point pc2)
)
(setq i (+ i kc2tl))
(setq j (1+ j))
;;;;;;;;;;(command ".change" "L" "" "p" "C" 8 "" ""); doi mau doi tuong
;(princ)
);repeat
(setvar "osmode" oldos)
(setvar "cecolor" oldco)
(vla-EndUndoMark doc)
(princ)
)

Chúc bạn vui.

Đoạn này đã như ý muốn chỉ có điều: khi đối tượng chuyển về màu 8 thì sau khi kết thúc lệnh màu của Layer hiện hành cũng là màu 8. Có cách nào để mặc định là Bylayer không ?
  • 0

#7 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 03 August 2011 - 02:42 PM

Đoạn này đã như ý muốn chỉ có điều: khi đối tượng chuyển về màu 8 thì sau khi kết thúc lệnh màu của Layer hiện hành cũng là màu 8. Có cách nào để mặc định là Bylayer không ?

Hề hề hề,
Hổng , hổng,.... hổng phải đâu.
Nó trả về cái màu mà trước đó bản vẽ của bạn xài bởi đoạn lisp nè: (setvar "cecolor" oldco)
Còn như bạn muốn nó trả về là bylayer thì hãy thay biến oldco trong đoạn lisp (setvar "cecolor" oldco) thành (setvar "cecolor" "bylayer") hoặc (setvar "cecolor" "256")
Chúc bạn vui.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 03 August 2011 - 03:38 PM
Bổ sung trả lời cho chủ thớt

  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#8 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 03 August 2011 - 02:56 PM

Hề hề hề,
Hổng , hổng,.... hổng phải đâu.
Nó trả về cái màu mà trước đó bản vẽ của bạn xài bởi đoạn lisp nè: (setvar "cecolor" oldco)
Còn như bạn muốn nó trả về là bylayer thì hãy thay biến oldco trong đoạn lisp trên thành "bylayer" hoặc "256"
Chúc bạn vui.

Cụ thể trong lisp nó ở chỗ nào nhỉ? Em chỉnh theo ý bác vẫn chưa được.
Do em nhầm. Bác Mod xóa bài này giúp em !
  • -3

#9 t031285

t031285

    biết vẽ rectang

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

Đã gửi 03 August 2011 - 06:28 PM

Hề hề hề,
bạn tham khảo đoạn code tạo lớp sau của bác ketxu nhé:
(if (not (tblsearch "layer" "daimoc"))
(command "-LAYER" "m" "daimoc" "c" 1 "daimoc" "")
)
Đoạn lisp trên kiểm tra xem trên bản vẽ đã có layer daimoc chưa, nếu chưa thì tạo layer daimoc mới vớ thuộc tính màu là 1 (đỏ).
Nếu bạn muốn thêm các thuộc tính khác thì cứ thế mà tiếp tục, bổ sung vào cuối lisp.
hề hề hề,...

Nếu muốn layer daimoc này là nét HIDDEN và có chiều dày là 0.5 thì phải thêm tiếp vào như thế nào vậy bác?Thanks.
  • -1

#10 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 04 August 2011 - 12:31 AM

Nếu muốn layer daimoc này là nét HIDDEN và có chiều dày là 0.5 thì phải thêm tiếp vào như thế nào vậy bác?Thanks.

Hề hề hề,
Thì như vầy:
(command "-LAYER" "m" "daimoc" "c" 1 "daimoc" "l" "hidden" "daimoc" "lw" 0.5 "daimoc" "")
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.