Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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

6 phút trước, quocmanh04tt đã nói:

Sr...! Các file *.dwg kia phải ở ver cad2007 trở về trước. Đó là khuôn mặt tác giả, khi không preview được.

Hay thật, tiếc là mã nguồn đóng, không học hỏi được phần này của bác rồ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
3 phút trước, Doan Nguyen Van đã nói:

Sau mấy ngày lục tung cả Google thì cũng tìm ra cái hàm show Block preview này. Bác nào cần không em gửi? @duy782006

 

Cho đi! Cám ơn.

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
2 phút trước, duy782006 đã nói:

Cho đi! Cám ơn.

(defun mai_get_dwg_preview ( tfile imgx imgy / 
           stream vecters row column
           bmp_widx bmp_widy loa loabmp lenbmp start_x start_y scale  color_num color_list
		   tt2 get_len fix_widx mm re_row
		   mai_10->16 mai_16->10  mai_stream_lst->num  mai_read_stream  mai_rgb->aci
		   mai_stream_just
                          )
;Convert a decimal number to a string list (sexadecimal)
(defun mai_10->16 ( num /  e n )
  (setq e "")
  (while (/= 0 num)
        (setq e (strcat (nth (rem num 16) (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F")) e)
			  num (fix (/ num 16))
		)
  )
  (cond ((= e "") "00")
        ((= (rem (strlen e) 2) 1) (strcat "0" e))
        (e)
  )		
)
;Convert a string list (sexadecimal) to a decimal number
(defun mai_16->10 ( txt /  e n nn)
  (setq e 0
        txt (vl-string->list (strcase txt))
		n (length txt)
  )
  (foreach nn txt
     (setq n (1- n))
     (if (/= nn "0")
        (setq nn (length
 		           (member (vl-list->string (list nn))
		               (list "F" "E" "D" "C" "B" "A" "9" "8" "7" "6" "5" "4" "3" "2" "1")
				   )
				 )
		      e (+ e (* nn (expt 16 n)))
		)
     )
  )
  e
)

(defun mai_stream_lst->num (lst / ) (mai_16->10 (apply 'strcat (mapcar 'mai_10->16 lst))))
 

(defun mai_read_stream ( xstream po len sty / a )
    (vlax-put xstream 'position (if po po 0))
  	(setq a (vlax-invoke-method xstream 'read (if len len (vlax-get xstream 'size)))
	      sty (strcase sty)
	)
	(cond ((= sty "STREAM") a)
	      (T 
		   (setq a (vlax-safearray->list (vlax-variant-value a))
	             a (mapcar '(lambda (x) (- x mai_stream_just)) a)
		   )
	       (cond ((= sty "LIST") a)
	             ((= sty "NUM") (mai_stream_lst->num (reverse a)))
	             ((= sty "STR")
				  (setq a (reverse a))
				  (while (= (car a) 0) (setq a (cdr a)))
	              (if a (vl-list->string (reverse a)))
				 )
		   )
		  )
	)
)


 (defun mai_rgb->aci (rgb-codes)
   (setq ColorObj
     (vla-GetInterfaceObject
         (vlax-get-acad-object)
         (strcat "AutoCAD.AcCmColor." ; "19")
         (substr 	(getvar "acadver") 1 2))
     )
   )
   (vla-setRGB ColorObj (car RGB-codes) (cadr RGB-codes) (caddr RGB-codes))
   (vla-get-ColorIndex ColorObj)
 )


 (defun get_len (lst / m n a e1 elb )
  (setq n 0 m 0 a (car lst))
  (foreach b lst
	 (setq n (1+ n))
     (if (not (= a b))
		 (setq e1 (if (= a 0) e1 (cons (list a m (+ m n)) e1))
		       a b m (+ m n) n 0
		 )
	 )
  )
  (if (= a 0)
      e1
	  (cons (list a m (+ m n)) e1)
  )
 )
 (vl-catch-all-apply
       '(lambda ()

 (vl-load-com)
	(setq stream (vlax-get-or-create-object "adodb.stream"))
	(vlax-invoke stream 'open )
	(vlax-put-property stream 'type 1)
	(vlax-invoke-method stream 'loadfromfile tfile)
    (vlax-put stream 'position 0)
	(setq mai_stream_just (- (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read 2)))) 65))
	;use the following value so as the different acad version can read the same binary value, the result is between 0-255
    (setq loa (+ (mai_read_stream stream 13 4 "num") 30));the 14th~17th record position + 30 byte record the image position
    (if (and (= 2 (mai_read_stream stream loa 1 "num"))
	         (> (setq loabmp (mai_read_stream stream (1+ loa) 4 "num")) 0);The start point of the image
		     (> (setq lenbmp (mai_read_stream stream (+ loa 5) 4 "num")) 0);the byte length of the image
		     (> (setq bmp_widx (mai_read_stream stream (+ 4 loabmp) 4 "num")) 0);read the width of the image
		     (> (setq bmp_widy (mai_read_stream stream (+ 8 loabmp) 4 "num")) 0);read the height of the image
		     (= 1 (mai_read_stream stream (+ 12 loabmp) 2 "num"));non-compress format
		     (= 8 (mai_read_stream stream (+ 14 loabmp) 2 "num"));8 bit color(256 color)
		     (setq color_num (1- (mai_read_stream stream (+ 32 loabmp) 2 "num")));the amount of the color index
		)
	  (progn
	    (setq fix_widx (* 4 (1+ (fix (* 0.25 (1- bmp_widx))))) ;each line must be a multiple of 4
		      loa (+ (- lenbmp (* fix_widx bmp_widy) (* 4 color_num)) loabmp);the pointer position, every 4 byte record a RGB color
		)
		(repeat color_num
		    (setq color_list (cons (mai_rgb->aci (cdr (reverse (mai_read_stream stream loa 4 "list")))) color_list)
				  loa (+ loa 4)
			)
		);Read all the color(True Color) index table, they must be convert to 256 index color.
		(if (not (and imgx imgy)) (setq imgx bmp_widx imgy bmp_widy));redefine the width and height of the image
         (setq scale (min (/ imgx (float bmp_widx)) (/ imgy (float bmp_widy)));redefine the ratio of the width and height
			   start_x (fix (* 0.5 (- imgx (* bmp_widx scale))));the x coordinate of the left top corner
			   start_y (fix (* 0.5 (- imgy (* bmp_widy scale))));the y coordinate of the right top corner
		       row (1+ bmp_widy);the line number of the image
		 )
         (repeat bmp_widy
             (vlax-put stream 'position loa)
			 (setq loa (+ loa fix_widx);the pointer position
		           row (1- row);the line number of the image
				   img_row (fix (+ start_y 0.5 (* scale row)));the y coordinate after the scaling
				   re_row (- img_row (fix (+ start_y 0.5 (* scale (1- row)))))
				   re_row (if (< re_row 2) 1 re_row);the repeat number of each line when zooming in the image
				   mm (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read bmp_widx)))
	               mm (mapcar '(lambda (x) (- x mai_stream_just)) mm)
			 )
			 ;readline bmp, from bottom to top, from left to right
	         (foreach tt2 (get_len mm)
			     (setq mm 0)
			     (repeat re_row ;the repeat number of each line when zooming in the image, which means the blank point between this line and the next line when filling and zoom this image
  					(setq vecters (cons (list (fix (+ start_x 0.5 (* scale (cadr tt2))));the x coordinate of the start point after scaling
								              (+ mm img_row)
								              (fix (+ start_x 0.5 (* scale (caddr tt2))));the x coordinate of the end point after scaling
								              (+ mm img_row)
								              (nth (- color_num (car tt2)) color_list);get true color from the index table
										)
										vecters
								  )
						  mm (1- mm)
                   )
                )
             )
	    )
      )
  )
  (and stream (vlax-invoke stream 'close))
  (and stream (vlax-release-object stream))
  (setq vecters (cons (list start_x start_y
             (fix (+ start_x 0.5 (* scale bmp_widx)))
             (fix (+ start_x 0.5 (* scale bmp_widy))) 
			 -2
	    );add the background color coordinate to the first item
		vecters)
  )
  )
  )
  vecters
)

(defun slide_image_dwg ( image dwgfile color / lenx leny img_date )
     (setq lenx (dimx_tile image)
           leny (dimy_tile image)
		   img_date (cdr (mai_get_dwg_preview dwgfile lenx leny))
     )
     (start_image image)
     (fill_image 0 0 lenx leny color)
	 (if img_date (mapcar '(lambda (x) (apply 'vector_image x)) img_date))
	 (end_image)
	 (princ)
)
;(slide_image_dwg "key" file color)

Đây nhé bác, test trên cad 14 dùng oke.

 

 

  • Like 4
  • 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
Vào lúc 12/8/2019 tại 10:57, Doan Nguyen Van đã nói:
  • cadvietlisp.lsp
    lisp help
  •  

(defun mai_get_dwg_preview ( tfile imgx imgy / 
           stream vecters row column
           bmp_widx bmp_widy loa loabmp lenbmp start_x start_y scale  color_num color_list
		   tt2 get_len fix_widx mm re_row
		   mai_10->16 mai_16->10  mai_stream_lst->num  mai_read_stream  mai_rgb->aci
		   mai_stream_just
                          )
;Convert a decimal number to a string list (sexadecimal)
(defun mai_10->16 ( num /  e n )
  (setq e "")
  (while (/= 0 num)
        (setq e (strcat (nth (rem num 16) (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F")) e)
			  num (fix (/ num 16))
		)
  )
  (cond ((= e "") "00")
        ((= (rem (strlen e) 2) 1) (strcat "0" e))
        (e)
  )		
)
;Convert a string list (sexadecimal) to a decimal number
(defun mai_16->10 ( txt /  e n nn)
  (setq e 0
        txt (vl-string->list (strcase txt))
		n (length txt)
  )
  (foreach nn txt
     (setq n (1- n))
     (if (/= nn "0")
        (setq nn (length
 		           (member (vl-list->string (list nn))
		               (list "F" "E" "D" "C" "B" "A" "9" "8" "7" "6" "5" "4" "3" "2" "1")
				   )
				 )
		      e (+ e (* nn (expt 16 n)))
		)
     )
  )
  e
)

(defun mai_stream_lst->num (lst / ) (mai_16->10 (apply 'strcat (mapcar 'mai_10->16 lst))))
 

(defun mai_read_stream ( xstream po len sty / a )
    (vlax-put xstream 'position (if po po 0))
  	(setq a (vlax-invoke-method xstream 'read (if len len (vlax-get xstream 'size)))
	      sty (strcase sty)
	)
	(cond ((= sty "STREAM") a)
	      (T 
		   (setq a (vlax-safearray->list (vlax-variant-value a))
	             a (mapcar '(lambda (x) (- x mai_stream_just)) a)
		   )
	       (cond ((= sty "LIST") a)
	             ((= sty "NUM") (mai_stream_lst->num (reverse a)))
	             ((= sty "STR")
				  (setq a (reverse a))
				  (while (= (car a) 0) (setq a (cdr a)))
	              (if a (vl-list->string (reverse a)))
				 )
		   )
		  )
	)
)


 (defun mai_rgb->aci (rgb-codes)
   (setq ColorObj
     (vla-GetInterfaceObject
         (vlax-get-acad-object)
         (strcat "AutoCAD.AcCmColor." ; "19")
         (substr 	(getvar "acadver") 1 2))
     )
   )
   (vla-setRGB ColorObj (car RGB-codes) (cadr RGB-codes) (caddr RGB-codes))
   (vla-get-ColorIndex ColorObj)
 )


 (defun get_len (lst / m n a e1 elb )
  (setq n 0 m 0 a (car lst))
  (foreach b lst
	 (setq n (1+ n))
     (if (not (= a b))
		 (setq e1 (if (= a 0) e1 (cons (list a m (+ m n)) e1))
		       a b m (+ m n) n 0
		 )
	 )
  )
  (if (= a 0)
      e1
	  (cons (list a m (+ m n)) e1)
  )
 )
 (vl-catch-all-apply
       '(lambda ()

 (vl-load-com)
	(setq stream (vlax-get-or-create-object "adodb.stream"))
	(vlax-invoke stream 'open )
	(vlax-put-property stream 'type 1)
	(vlax-invoke-method stream 'loadfromfile tfile)
    (vlax-put stream 'position 0)
	(setq mai_stream_just (- (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read 2)))) 65))
;use the following value so as the different acad version can read the same binary value, the result is between 0-255
    (setq loa (+ (mai_read_stream stream 13 4 "num") 30));the 14th~17th record position + 30 byte record the image position
    (if (and (= 2 (mai_read_stream stream loa 1 "num"))
	         (> (setq loabmp (mai_read_stream stream (1+ loa) 4 "num")) 0);The start point of the image
		     (> (setq lenbmp (mai_read_stream stream (+ loa 5) 4 "num")) 0);the byte length of the image
		     (> (setq bmp_widx (mai_read_stream stream (+ 4 loabmp) 4 "num")) 0);read the width of the image
		     (> (setq bmp_widy (mai_read_stream stream (+ 8 loabmp) 4 "num")) 0);read the height of the image
		     (= 1 (mai_read_stream stream (+ 12 loabmp) 2 "num"));non-compress format
		     (= 8 (mai_read_stream stream (+ 14 loabmp) 2 "num"));8 bit color(256 color)
		     (setq color_num (1- (mai_read_stream stream (+ 32 loabmp) 2 "num")));the amount of the color index
		)
	  (progn
	    (setq fix_widx (* 4 (1+ (fix (* 0.25 (1- bmp_widx))))) ;each line must be a multiple of 4
		      loa (+ (- lenbmp (* fix_widx bmp_widy) (* 4 color_num)) loabmp);the pointer position, every 4 byte record a RGB color
		)
		(repeat color_num
		    (setq color_list (cons (mai_rgb->aci (cdr (reverse (mai_read_stream stream loa 4 "list")))) color_list)
				  loa (+ loa 4)
			)
		);Read all the color(True Color) index table, they must be convert to 256 index color.
		(if (not (and imgx imgy)) (setq imgx bmp_widx imgy bmp_widy));redefine the width and height of the image
         (setq scale (min (/ imgx (float bmp_widx)) (/ imgy (float bmp_widy)));redefine the ratio of the width and height
			   start_x (fix (* 0.5 (- imgx (* bmp_widx scale))));the x coordinate of the left top corner
			   start_y (fix (* 0.5 (- imgy (* bmp_widy scale))));the y coordinate of the right top corner
		       row (1+ bmp_widy);the line number of the image
		 )
         (repeat bmp_widy
             (vlax-put stream 'position loa)
			 (setq loa (+ loa fix_widx);the pointer position
		           row (1- row);the line number of the image
				   img_row (fix (+ start_y 0.5 (* scale row)));the y coordinate after the scaling
				   re_row (- img_row (fix (+ start_y 0.5 (* scale (1- row)))))
				   re_row (if (< re_row 2) 1 re_row);the repeat number of each line when zooming in the image
				   mm (vlax-safearray->list (vlax-variant-value (vlax-invoke-method stream 'read bmp_widx)))
	               mm (mapcar '(lambda (x) (- x mai_stream_just)) mm)
			 )
			 ;readline bmp, from bottom to top, from left to right
	         (foreach tt2 (get_len mm)
			     (setq mm 0)
			     (repeat re_row ;the repeat number of each line when zooming in the image, which means the blank point between this line and the next line when filling and zoom this image
  					(setq vecters (cons (list (fix (+ start_x 0.5 (* scale (cadr tt2))));the x coordinate of the start point after scaling
								              (+ mm img_row)
								              (fix (+ start_x 0.5 (* scale (caddr tt2))));the x coordinate of the end point after scaling
								              (+ mm img_row)
								              (nth (- color_num (car tt2)) color_list);get true color from the index table
										)
										vecters
								  )
						  mm (1- mm)
                   )
                )
             )
	    )
      )
  )
  (and stream (vlax-invoke stream 'close))
  (and stream (vlax-release-object stream))
  (setq vecters (cons (list start_x start_y
             (fix (+ start_x 0.5 (* scale bmp_widx)))
             (fix (+ start_x 0.5 (* scale bmp_widy))) 
			 -2
	    );add the background color coordinate to the first item
		vecters)
  )
  )
  )
  vecters
)

(defun slide_image_dwg ( image dwgfile color / lenx leny img_date )
     (setq lenx (dimx_tile image)
           leny (dimy_tile image)
		   img_date (cdr (mai_get_dwg_preview dwgfile lenx leny))
     )
     (start_image image)
     (fill_image 0 0 lenx leny color)
	 (if img_date (mapcar '(lambda (x) (apply 'vector_image x)) img_date))
	 (end_image)
	 (princ)
)
;(slide_image_dwg "key" file color)

Đây nhé bác, test trên cad 14 dùng oke.

 

 

Bạn áp dụng có sửa chổ nào không. Mình áp dụng i nguyên nó ra cái nền màu trắng chứ không đen được, thấy ghét lắm.

 

tvth.jpg

Mình tin là không phải do mình không biết đổi màu nền của dcl vì thủ cái lisp IOD của @quocmanh04tt giới thiệu vẫn bị tình trạng y chang. Không biết do cấu hình hay win vì các đời cad từ 2007 đến 2016 vẫn thế.

 

iod.jpg

  • Like 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
8 phút trước, duy782006 đã nói:

Bạn áp dụng có sửa chổ nào không. Mình áp dụng i nguyên nó ra cái nền màu trắng chứ không đen được, thấy ghét lắm.

 

Mình tin là không phải do mình không biết đổi màu nền của dcl vì thủ cái lisp IOD của @quocmanh04tt giới thiệu vẫn bị tình trạng y chang. Không biết do cấu hình hay win vì các đời cad từ 2007 đến 2016 vẫn thế.

 

 

(slide_image_dwg "key" file color)

Bác để cái biến color kia là bao nhiêu? giá trị đó quyết định màu nền của Image thì phải, e đổi qua mấy số mới được nền đen

  • Like 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
8 phút trước, Doan Nguyen Van đã nói:

(slide_image_dwg "key" file color)

Bác để cái biến color kia là bao nhiêu? giá trị đó quyết định màu nền của Image thì phải, e đổi qua mấy số mới được nền đen

Vụ này mình biết mà. Nó bị tình trạng như cái hình mình minh hoạ chạy lisp IOD thấy có 2 khoảng màu đen đó. Cái biến color chỉ tác dụng thay màu của 2  khoảng màu đen đó thôi còn cái phần màu trắng nó dính dô hình luôn mới đau.

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
14 phút trước, duy782006 đã nói:

Vụ này mình biết mà. Nó bị tình trạng như cái hình mình minh hoạ chạy lisp IOD thấy có 2 khoảng màu đen đó. Cái biến color chỉ tác dụng thay màu của 2  khoảng màu đen đó thôi còn cái phần màu trắng nó dính dô hình luôn mới đau.

E vừa test mấy bản vẽ thấy cũng có trường hợp bị như vậy, pu all hay copy save as thế nào cũng vẫn bị, có lẽ do đối tượng trong file làm ảnh hưởng, mà không biết ảnh hưởng như thế nào

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

OK. Tưởng có giải pháp cho cái thư viện nhưng kiểu này hông ổn. Mình đổi màu nền thành -2 thì có ô đen, ô trắng, ô lôm môm dòm thiệt ngứa con mắt. Và file cad 2016 hông hiện được. Lại chung thuỷ với sld thôi.

  • Like 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
7 phút trước, Doan Van Ha đã nói:

Nó là lệnh (comamnd), không phải biến.

OSNAP

Vậy không có cách này tắt được bằng lisp hả bạn ơi ?

Mình cần tắt bắt điểm mà ko tác động vào osmode ý

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
14 phút trước, Doan Nguyen Van đã nói:

Bác có thể sử dụng lisp mà, lưu 1 biến thành biến hệ thống.


(defun os_on_off ()
  (if (/= (getvar 'osmode) 0) (progn (setq bien_mode (getvar 'osmode)) (setvar 'osmode 0))
    (progn (if bien_mode (setvar 'osmode bien_mode))))
  
  )

 

Bạn lại hiểu nhầm giữa osnap và osmode rồi.

10 phút trước, ngokiet đã nói:

(setvar 'osmode (boole 6 (getvar 'osmode) 16384))

Thử code trên

Oh đúng cái mình cần luôn, cảm ơn bạn nhé !

Vậy hóa ra lâu nay ko để ý là:

osmode 1 là endpoint - osnap bật

osmode 16385 là endpoint - osnap tắ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
32 phút trước, Duong Nhat Duy đã nói:

Vậy không có cách này tắt được bằng lisp hả bạn ơi ?

Mình cần tắt bắt điểm mà ko tác động vào osmode ý

Do chỗ tô đen khó hiểu quá!

  • Like 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
1 phút trước, Doan Van Ha đã nói:

Do chỗ tô đen khó hiểu quá!

Do tăt mở không phải là biến riêng mà nó chỉ là 1 bit trong osmode thôi. Nên chỉ thay đổi bit đó là được. Có thể +/- 16384 là được.

Nhiều bác viết lisp hay set về 0 nên khi hàm lỗi mà ko viết hàm bẫy lỗi làm mất setting osmode rất khó chịu. Dùng cách này thì ok hơn.

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
3 phút trước, ngokiet đã nói:

Do tăt mở không phải là biến riêng mà nó chỉ là 1 bit trong osmode thôi. Nên chỉ thay đổi bit đó là được. Có thể +/- 16384 là được.

Nhiều bác viết lisp hay set về 0 nên khi hàm lỗi mà ko viết hàm bẫy lỗi làm mất setting osmode rất khó chịu. Dùng cách này thì ok hơn.

Tôi hiểu. Nhưng do câu tô đen hơi khó hiểu thô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
49 phút trước, tien2005 đã nói:

Vậy có đoạn code nào để kiểm tra osnap đang ON/OFF hay không?

(< (getvar ‘osmode) 16384)

 

Lưu ý là osmode = 0 dù ko bắt điểm thì osnap vẫn on.

Vì bít check cuối nên mình dùng hàm >. Check các bit khác dùng hàm boole.

 

  • Like 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
20 phút trước, anhGeodesy đã nói:

Xin chỉ giáo:

Hàm (vla-get-elevation obj) lấy Z của Polyline vậy có hàm nào Vla lấy được Z của Text không? xin cảm ơn !

Không có hàm trực tiếp mà phải lấy vị trí sau đó lấy caddr của nó.

  • 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

 

27 phút trước, Doan Van Ha đã nói:

Không có hàm trực tiếp mà phải lấy vị trí sau đó lấy caddr của nó.

Cảm ơn Bác @Doan Van Ha Cháu đang Sửa cái đoạn Lisp phối màu Đường đồng mức của bác Link:

Đoạn Code :

(defun SetColor(lstobj dz / vung col1 col2 lst_elev ocol oRGBcol lst_col)
 (setq lst_elev (mapcar '(lambda(obj) (fix (/ (vla-get-elevation obj) dZ))) lstobj))
 (setq lst_elev (vl-sort lst_elev '<) vung (- (last lst_elev) (car lst_elev)))
; (setq col1 (mapcar 'float (TrueColor-split (cdr (assoc 420 (acad_truecolordlg (cons 420 (LM:RGB->True 255 0 0)) nil))))))
; (setq col2 (mapcar 'float (TrueColor-split (cdr (assoc 420 (acad_truecolordlg (cons 420 (LM:RGB->True 40 255 40)) nil))))))
 (setq col1 (mapcar 'float '(255 0 0)) col2 (mapcar 'float '(0 0 255)))
 (setq lst_col (RangeCol col1 col2 vung))
 (foreach obj lstobj
  (setq ocol (vlax-get-property obj 'TrueColor) oRGBcol (mapcar 'fix (nth (- (fix (/ (vla-get-elevation obj) dZ)) (car lst_elev)) lst_col)))
  (vlax-invoke-method ocol 'SetRGB (car oRGBcol) (cadr oRGBcol) (caddr oRGBcol))
  (vlax-put-property obj 'TrueColor ocol)
  (vla-update obj)))

 

Đây là Code lấy Z Nhưng update Màu thì cháu đang bị vướng.

(defun c:00 (/ Lstename Lst_Pnt)
(setq ss (ssget '((0 . "TEXT"))))
(setq Lstename (GE:SS->Lst ss nil)) ;(princ Lstename)
(setq Lst_Pnt (mapcar '(lambda (ename)
             (setq Ndt (cdr (assoc 1 (entget ename)))
                   Pnt (TD:Text-Base (cdr (assoc -1 (entget ename))))
             )
               )
              Lstename
          )
)
  (setq Lst_elev (mapcar '(lambda (elev)
             (Setq Caodo (Last elev))
               )
             Lst_Pnt
          )
)
  (princ Lst_elev)
  )

(defun TD:Text-Base (ent / MA71 MA72 X11); Ham xet Justify lay dung toa do By TDuan
  (setq Ma10 (cdr (assoc 10 (entget ent))))
  (setq Ma11 (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71 (cdr (assoc 71 (entget ent))))
  (setq Ma72 (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
      (and (= Ma71 0) (= Ma72 3))
      (and (= Ma71 0) (= Ma72 5))
      )
    Ma10
    Ma11
  )
)
;(setq lstEnt (GE:SS->Lst ss nil))
;----- SelectionSet -> List Ename or Vla-object
(defun GE:SS->Lst (ss flag / lst)
  (and ss
       (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
       (if flag
     (setq lst (mapcar 'vlax-ename->vla-object lst))
       )
  )
  lst
)

Để áp dụng Phối màu cho Text Cao độ, Nhưng bị vướng chưa làm được, Mong Bác trợ giúp. trân trọng và cảm ơ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

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

×