;;------------------=={ Layer Draw Order }==------------------;;
;;                                                            ;;
;;  Allows the user to control the draw order of all objects  ;;
;;  on a layer relative to other layers in the drawing.       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.2    -    20-06-2011                            ;;
;;------------------------------------------------------------;;


(defun c:lm_ldorder ( /
						mai_list_sort_temp
						old_cmd
						_writedcl
            refreshlayer1

						acdoc
						dclfname
						dclid
						dcltitle
						dflag
						layer1
						layer2
						layers
						value1
						value2
				)
(mai_last_com "lm_ldorder")



(defun _WriteDCL ( )
	(mai_make_dcl
		(append
			(list
				"button12:button{width=12;fixed_width=true;}"
				"button20:button{width=20;fixed_width=true;height=2.1;fixed_height=true;}"
				"ldorder:dialog{key=\"dcltitle\";"
				":column{"
					":row{"
						 ":boxed_column{label=\"所有图层\";"
							":list_box{key=\"layer1\";height=37;width=35;multiple_select=true;fixed_height=true;}"
							":edit_box{key=\"filter\";label=\"图层过滤:\";width=35;}
							spacer;"
							"}"
						":boxed_column{label=\"调整绘图顺序的图层\";"
			)
			(mai_list_sort_ui_dcl 42 35 2)
			(list
						":edit_box{key=\"pattern\";label=\"增加样式:\";width=42;}"
						"spacer;"
						"}"
					"}"
				":row{fixed_width=true;alignment=centered;"
					":button20{label=\"移到最上面，确定\";key=\"totop\";is_default=true;}"
					":button20{label=\"移到最下面，确定\";key=\"tobottom\";}"
					":button12{label=\"取      消\";key=\"cancel\";is_cancel=true;}"
					"}"
				"}"
				"}"
			)
		)
	)
)

;;------------------------------------------------------------;;


(defun refreshlayer1 ( / tt )
	(setq
		tt (mapcar 'car (car mai_list_sort_temp))
		layer1
			(vl-remove-if
				'(lambda ( x )
					(or (member (car x) tt)
						(vl-some '(lambda ( p ) (wcmatch (strcase (car x)) p)) tt)
					)
				)
				layers
			)
	)
	(mai_filldcl_list "layer1" (mapcar 'car layer1))
	(if value1 (set_tile "layer1" value1))
)

	;;------------------------------------------------------------;;
	(mini_start nil)
	(setq
		acdoc (vlax-get (vlax-get-acad-object) 'activedocument)
		dclfname (_WriteDCL)
		dclid (load_dialog dclfname)
		layers (mai_tblsearch "layer")
		value1 (itoa (vl-position (getvar 'CLAYER) layers))
		layers (mapcar 'list layers)
		layer1 layers
	)

	(new_dialog "ldorder" dclid)
	(set_tile "dcltitle" "按图层调整绘图顺序-迷你建筑工具修改版")



	(mai_list_sort_ui nil 'refreshlayer1)
	(refreshlayer1)
	(set_tile "filter" "*")
	(action_tile "layer1"
		(vl-prin1-to-string
			'(	(lambda ( / items n )
					(setq value1 "" items (mapcar '(lambda(n) (nth n layer1)) (read (strcat "(" $value ")"))))
					(and
						items
						(if (= 4 $reason)
							(progn
								(setq
									n (1- (car mai_list_sort_temp))
									mai_list_sort_temp (list (append (car mai_list_sort_temp) items) (mapcar '(lambda(x)(setq n (1+ n))) items) (caddr mai_list_sort_temp) nil)
									value1 ""
								)
								(refreshlayer1)
							)
							(setq
								value1 $value
								mai_list_sort_temp (list (car mai_list_sort_temp) (cadr mai_list_sort_temp) (caddr mai_list_sort_temp) items)
							)
						)
					)
					(mai_list_sort_refresh)
				)
			)
		)
	)




	(action_tile "filter"
		(vl-prin1-to-string
			'(	(lambda ( /  tt )
					(if (= 1 $reason)
						(cond
							(	(eq "" (setq pattn (strcase $value)))
								(set_tile "filter" "*")
								(setq
									tt (car mai_list_sort_temp)
									layer1
										(vl-remove-if
											'(lambda ( x )
												(or (vl-position x tt)
													(vl-some '(lambda ( p ) (wcmatch (strcase (car x)) p)) tt)
												)
											)
											layers
										)
									value1 ""
									mai_list_sort_temp (list (car mai_list_sort_temp) (cadr mai_list_sort_temp) (caddr mai_list_sort_temp) nil)
								)
								(refreshlayer1)
								(mode_tile "add" 1)
							)
							( 	t
								(setq
									layer1 (vl-remove-if-not '(lambda ( x ) (wcmatch (strcase (car x)) pattn)) layer1)
									value1 ""
									mai_list_sort_temp (list (car mai_list_sort_temp) (cadr mai_list_sort_temp) (caddr mai_list_sort_temp) nil)
								)
								(refreshlayer1)
								(mode_tile "add" 1)
							)
						)
					)
				)
			)
		)
	)

	(action_tile "pattern"
		(vl-prin1-to-string
			'(	(lambda ( /  tt )
					(setq tt (car mai_list_sort_temp))
					(if (= 1 $reason)
						(cond
							(	(eq "" (setq pattn (strcase $value))))
							(	(=
									(length (append layer1 tt))
									(+	(length (setq filt1 (vl-remove-if '(lambda ( x ) (wcmatch (strcase (car x)) pattn)) layer1)))
										(length (setq filt2 (vl-remove-if '(lambda ( x ) (wcmatch (strcase (car x)) pattn)) tt)))
									)
								)
								(alert "没有找到匹配的样式.")
								(mode_tile "pattern" 2)
							)
							( 	t
								(setq
									tt (append filt2 (list (list pattn)))
									layer1 filt1
									value1 ""
									mai_list_sort_temp (list tt nil (caddr mai_list_sort_temp) nil)
								)
								(set_tile  "pattern" "")
								(refreshlayer1)
								(mai_list_sort_refresh)
							)
						)
					)
				)
			)
		)
	)


	(action_tile "totop"    "(done_dialog 1)")
	(action_tile "tobottom" "(done_dialog 2)")

	(if (member (setq dflag (start_dialog)) '(1 2))
		(progn
			(LDOrder   acdoc (mapcar 'car layer2) (= 1 dflag))
			(vla-regen acdoc acactiveviewport)
			(princ "\n--> 绘图顺序已按图层调整.")
		)
		(princ "\n*Cancel*")
	)
	(if dclid (unload_dialog dclid))
	(mai_end)
)

;;------------=={ Layer Draw Order Subfunction }==------------;;
;;                                                            ;;
;;  Adjusts the draw order of all entities on each layer      ;;
;;  (or set of layers matching a wildcard pattern) in a       ;;
;;  supplied list to reflect the order of the list.           ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  acdoc  - VLA Document Object                              ;;
;;  layers - List of layer names or wildcard patterns         ;;
;;  toTop  - T=order layers above others, nil=below others    ;;
;;------------------------------------------------------------;;

(defun LDOrder ( acdoc layers toTop / _SortentsTable _SafearrayVariant )

;;------------------------------------------------------------;;

	(defun _SortentsTable ( space / dict result )
		(cond
			(
				(not
					(vl-catch-all-error-p
						(setq result
							(vl-catch-all-apply 'vla-item
								(list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS")
							)
						)
					)
				)
				result
			)
			(	(vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") )
		)
	)

;;------------------------------------------------------------;;

	(defun _SafearrayVariant ( datatype data )
		(vlax-make-variant
			(vlax-safearray-fill
				(vlax-make-safearray datatype (cons 0 (1- (length data)))) data
			)
		)
	)

;;------------------------------------------------------------;;

	(
		(lambda ( sortents func / ss x )
			(foreach x (if toTop (reverse layers) layers)
				(if (setq ss (ssget "_X" (list (cons 8 x) (cons 410 (getvar 'CTAB)))))
					(func sortents (_SafearrayVariant vlax-vbobject (mapcar 'vlax-ename->vla-object (mai_ssget_2_list ss))))
				)
			)
		)
		(_SortentsTable (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)))
		(if toTop vla-movetotop vla-movetobottom)
	)
	(princ)
)
(princ)
