Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Lisp xác định nhanh màu sắc đối tượng để đặt nét in.


  • Please log in to reply
2 replies to this topic

#1 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 08 May 2014 - 09:54 AM

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.

;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#2 ksthanhkv

ksthanhkv

    Chưa sử dụng CAD

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

Đã gửi 08 May 2014 - 12:25 PM

sao mình load mà không dùng được vậy bạn.


  • 0

#3 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 May 2014 - 12:26 PM

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.

;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 

Hề hề hề,

Thanh bác DoanVanHa về lisp xác định màu này.

Sau khi test thử mình thấy có một vài ý kiến như sau:

1/- Mình xài CAD2004 nên khi xài lisp thì việc di chuột trên màn hình bị giật cục chứ không mịn màng như trước và rất khó chọn trúng đối tượng cần xác định. 

2/- Vị trí đối tượng được chọn (cái ô màu xanh lá) chỉ hiển thị sau khi có hiển thị màu của đối tượng và do đó nếu chọn nhầm thì chỉ có nước .... chọn lại.

3/- Thời gian để xác định màu của một đối tượng chưa .....nhanh lắm bởi với CAD2004 của mình thì mất khoảng > 3 giây, và không có việc lưu lại kết quả này,(chỉ hiển thị xong rồi lại biến mất khi chuột di chuyển. Như vậy với cái trí nhớ cà lăm của mình thì đôi khi chọn được rồi lại phải chọn lại.

 

Rất mong bác nếu có thể sẽ hoàn thiện thêm để lisp có ứng dụng thuận tiện hơn.

Chúc bác khỏe và vui.


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