;;-----------------=={ Move Attributes }==--------------------;;
;;                                                            ;;
;;  Prompts user for a selection of attribute tag and         ;;
;;  selection of blocks containing such tag for which the     ;;
;;  change will be applied.                                   ;;
;;                                                            ;;
;;  Subsequently prompts user for a base point and            ;;
;;  displacement and proceeds to move all attributes of the   ;;
;;  selected tag within the selected blocks.                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:lm_mvAtt ( / old_cmd doc asel base disp ss tag e )
	(mini_start nil)
	(mai_last_com "lm_mvAtt")
	(setq doc (vlax-get (vlax-get-acad-object) 'ActiveDocument))
	(and
		(setq asel (LM:GetAttribSelection))
		(setq base (getpoint "\n输入基点 :<退出>"))
		(setq disp (getpoint base "\n输入第二点 :<退出>"))
		(setq
			base (vlax-3D-point (trans base 1 0))
			disp (vlax-3D-point (trans disp 1 0))
		)
		(progn
			(setq
				ss (cadr asel)
				tag (caddr asel)
				ss (mai_ssget_2_list ss)
			)
			(foreach e ss
				(setq e (vlax-ename->vla-object e))
				(mapcar
					'(lambda (x) (if (eq tag (vlax-get x 'TagString)) (vla-move x base disp)))
					(append (vlax-invoke e 'GetAttributes) (vlax-invoke e 'GetConstantAttributes))
				)
			)
		)
	)
	(mai_end)
)

;;-----------------=={ Rotate Attributes }==------------------;;
;;                                                            ;;
;;  Prompts user for a selection of attribute tag and         ;;
;;  selection of blocks containing such tag for which the     ;;
;;  change will be applied.                                   ;;
;;                                                            ;;
;;  Subsequently prompts user for a rotation angle and        ;;
;;  proceeds to set the rotation of all attributes of the     ;;
;;  selected tag within the selected blocks to the specified  ;;
;;  angle.                                                    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:lm_roAtt ( / old_cmd asel base disp ss tag e o )
	(mini_start nil)
	; (setq doc (vlax-get (vlax-get-acad-object) 'ActiveDocument))
	(and
		(setq asel (LM:GetAttribSelection))
		(setq base
				(vlax-get (setq o (vlax-ename->vla-object (car asel)))
					(if (and
							(or (not (vlax-property-available-p o 'MTextAttribute))
								(eq :vlax-fasle (vlax-get-property o 'MTextAttribute))
							)
							(not (eq acAlignmentLeft (vlax-get-property o 'Alignment))) ;(vla-get-Alignment (vlax-ename->vla-object (car(entsel))))
						)
						'TextAlignmentPoint
						'InsertionPoint
					)
				)
		)
		(setq base (trans base 0 1))
		(setq disp (getangle "\n输入旋转角度 :" base))
		(setq disp (+ disp (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 t) t))))
		(progn
			(setq
				ss (cadr asel)
				tag (caddr asel)
				ss (mai_ssget_2_list ss)
			)
			(foreach e ss
				(setq e (vlax-ename->vla-object e))
				(mapcar
					'(lambda (x) (if (eq tag (vlax-get x 'tagstring)) (vlax-put x 'rotation disp)))
					(append (vlax-invoke e 'GetAttributes) (vlax-invoke e 'GetConstantAttributes))
				)
			)
		)
	)
	(mai_end)
)

;;-------------------=={ Edit Attributes }==------------------;;
;;                                                            ;;
;;  Prompts user for a selection of attribute tag and         ;;
;;  selection of blocks containing such tag for which the     ;;
;;  change will be applied.                                   ;;
;;                                                            ;;
;;  Subsequently displays a dialog interface allowing the     ;;
;;  to change such properties as content, style, alignment,   ;;
;;  height, oblique angle, and rotation. Upon clicking OK     ;;
;;  all attributes of the selected tag within the selected    ;;
;;  blocks will be modified to suit the checked properties.   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:lm_edAtt ( / old_cmd LM:WriteDCL doc dcfname mode s hgt obl rot
				   TextStyles AlignLst asel dcTag dcFlag o ss tag e2 e4 e8 e16 e32 e64 )


(defun LM:WriteDCL ( )
	(setq dcfname
		(mai_make_dcl
			(list
				"edit5:edit_box{edit_limit=5;fixed_width=true;}"
				"pop:popup_list{width=20;fixed_width=true;}"
				"EdAtt:dialog{key=\"dctitle\";label=\"块属性编辑\";initial_focus=\"内容\"; spacer;"
				":toggle{key=\"t2\";label=\"内容\";}"
				":edit_box{key=\"e2\";width=45;fixed_width=true;} spacer;"
				":row{:toggle{key=\"t4\";label=\"字形\";} :pop{key=\"e4\";}}"
				":row{:toggle{key=\"t8\";label=\"对齐方式\";} :pop{key=\"e8\";}}"
				":row{:toggle{key=\"t16\";label=\"高度\";} : edit5{key=\"e16\";}}"
				":row{:toggle{key=\"t32\";label=\"倾斜角度\";} :edit5{key=\"e32\";}}"
				":row{:toggle{key=\"t64\";label=\"旋转\";} :edit5{key=\"e64\";}} spacer;ok_cancel;}"
			)
		)
	)
)


	(mini_start nil)
	(or mode (setq mode 2))
	(setq
		; doc (vlax-get (vlax-get-acad-object) 'ActiveDocument)
		; TextStyles (acad_strlsort (vlax-for s (vlax-get doc 'TextStyles) (setq TextStyles (cons (vlax-get s 'Name) TextStyles))))
		TextStyles (mai_tblsearch "style")
		AlignLst
			(list
				(cons "Left"          acAlignmentLeft        )
				(cons "Center"        acAlignmentCenter      )
				(cons "Right"         acAlignmentRight       )
				(cons "Aligned"       acAlignmentAligned     )
				(cons "Middle"        acAlignmentMiddle      )
				(cons "Fit"           acAlignmentFit         )
				(cons "Top-Left"      acAlignmentTopLeft     )
				(cons "Top-Center"    acAlignmentTopCenter   )
				(cons "Top-Right"     acAlignmentTopRight    )
				(cons "Middle-Left"   acAlignmentMiddleLeft  )
				(cons "Middle-Center" acAlignmentMiddleCenter)
				(cons "Middle-Right"  acAlignmentMiddleRight )
				(cons "Bottom-Left"   acAlignmentBottomLeft  )
				(cons "Bottom-Center" acAlignmentBottomCenter)
				(cons "Bottom-Right"  acAlignmentBottomRight )
			)
	)

	(cond
		(	(not (LM:WriteDCL))
			(mai_dos_Popup "警告" 16 "无法写出DCL对话框文件")
			(princ "\n** 无法写出DCL对话框文件 **")
			(exit)
		)
		(	(not (setq asel (LM:GetAttribSelection)))
			(exit)
		)
		(	(<= (setq dcTag (load_dialog dcfname)) 0)
			(mai_dos_Popup "警告" 16 "没找到DCL对话框文件")
			(princ "\n** 没找到DCL对话框文件 **")
			(exit)
		)
		(	(not (new_dialog "EdAtt" dcTag))
			(mai_dos_Popup "警告" 16 "无法加载DCL对话框文件")
			(princ "\n** 无法加载DCL对话框文件 **")
			(exit)
		)
		(	t
			(mapcar 'mai_filldcl_list '("e4" "e8") (list TextStyles (mapcar 'car AlignLst)))
			(setq
				o (vlax-ename->vla-object (car asel))
				ss (mai_ssget_2_list (cadr asel))
				tag (caddr asel)
			)
			(
				(lambda ( i )
					(mapcar
						'(lambda ( toggle edit vvalue )
							(setq i (lsh i 1))
							(mode_tile edit (- 1 (atoi (set_tile toggle (if (= i (logand i mode)) "1" "0")))))
							(set (read edit) (set_tile edit vvalue))
							(action_tile toggle
								(strcat "(setq mode ((if (eq \"1\" $value) + -) mode " (itoa i) "))"
										"(mode_tile " (vl-prin1-to-string edit) " (- 1 (atoi $value)))"
								)
							)
							(action_tile edit (strcat "(setq " edit " $value)"))
						)
						'("t2" "t4" "t8" "t16" "t32" "t64")
						'("e2" "e4" "e8" "e16" "e32" "e64")
						(list
							(vlax-get o 'TextString)
							(itoa (vl-position (vlax-get o 'StyleName) TextStyles))
							(itoa (vl-position (vlax-get o 'Alignment) (mapcar 'cdr AlignLst)))
							(rtos (vlax-get o 'Height))
							(angtos (vlax-get o 'ObliqueAngle))
							(angtos (vlax-get o 'Rotation))
						)
					)
				)
				1
			)

			(action_tile "accept"
				(vl-prin1-to-string
					(quote
						(progn
							(cond
								(	(not (and (setq hgt (distof e16)) (< 0 hgt)))
									(mai_dos_Popup "消息" 48 "属性高度必须是数字!")
								)
								(	(not (and (setq obl (angtof e32)) (<= (/ (* pi -17.) 36.) obl (/ (* pi 17.) 36.))))
									(mai_dos_Popup "消息" 48 "倾斜角度必须在 -85° 到 85° 之间")
								)
								(	(not (setq rot (angtof e64)))
									(mai_dos_Popup "消息" 48 "属性旋转角度必须是数字")
								)
								(t
									(setq
										e4 (nth (atoi e4) TextStyles)
										e8 (cdr (nth (atoi e8) AlignLst))
										e16 hgt
										e32 obl
										e64 rot
									)
									(done_dialog 1)
								)
							)
						)
					)
				)
			)

			(setq
				dcFlag (start_dialog)
				dcTag (unload_dialog dcTag)
			)

			(if (= 1 dcFlag)
				(	(lambda ( props / e )
						(foreach e ss
							(mapcar
								'(lambda ( attrib )
									(if (eq tag (vlax-get attrib 'TagString))
										(mapcar
											'(lambda ( prop / err tmp )
												(if (eq (car prop) 'Alignment)
													(setq tmp (vlax-get attrib 'InsertionPoint))
												)
												(setq err (vl-catch-all-apply 'vlax-put (cons attrib prop)))
												(if (vl-catch-all-error-p err)
													(princ (strcat "\n错误: " (vl-catch-all-error-message err)))
												)
												(and tmp
													(not (eq acAlignmentLeft (cadr prop)))
													(vlax-put attrib 'TextAlignmentPoint tmp)
												)
											)
											props
										)
									)
								)
								(vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
							)
						)
					)

					(
						(lambda ( j )
							(vl-remove-if 'null
								(mapcar
									'(lambda ( prop )
										(setq j (lsh j 1))
										(if (= j (logand j mode))
											(list prop (eval (read (strcat "e" (itoa j)))))
										)
									)
									'(TextString StyleName Alignment Height ObliqueAngle Rotation)
								)
							)
						)
						1
					)
				)
				(princ "\n*Cancel*")
			)
		)
	)
	(mai_end)
)

;;---------------=={ Get Attribute Selection }==--------------;;
;;                                                            ;;
;;  Prompts user to select an attribute, then a selection of  ;;
;;  blocks containing such attribute                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  doc        - a VLA Document Object                        ;;
;;  AllowMText - Boolean flag determining whether MText       ;;
;;               attributed are selectable (T=Allow MText)    ;;
;;------------------------------------------------------------;;
;;  Returns: list of (<Attribute> <SelectionSet> <TagString>) ;;
;;------------------------------------------------------------;;

; (defun LM:GetAttribSelection ( doc AllowMText / e b tag o mutt ss )
	; (if
		; (and
			; (setq e
				; (LM:Selectif
					; (lambda ( x / y )
						; (and
							; (eq "ATTRIB" (mai_dxf 0 x))
							; (setq y (vlax-ename->vla-object x))
							; (or AllowMText
								; (not (vlax-property-available-p y 'MTextAttribute))
								; (eq :vlax-false (vlax-get-property y 'MTextAttribute))
							; )
						; )
					; )
					; nentsel
					; "\n选择属性:"
				; )
			; )
			; (princ (strcat "\n[ " (mai_dxf 2 e) " ]被选择."))
			; (setq
				; o (vlax-ename->vla-object e)
				; b (mai_block_name (vla-ObjectIDtoObject doc (vlax-get o 'OwnerId)))
				; tag (vlax-get o 'TagString)
			; )
			; (progn
				; (setq mutt (getvar 'NOMUTT))
				; (setvar 'NOMUTT 1)
				; (princ "\n选择块:<回车全选>")
				; (setq
					; ss (list (cons 0 "INSERT") (cons 2 b) (cons 66 1))
					; ss (cond
							; ((ssget ss))
							; ((ssget "_X" ss))
						; )
				; )
				; (setvar 'NOMUTT mutt)
				; ss
			; )
		; )
		; (list o ss tag)
	; )
; )
(defun LM:GetAttribSelection ( / e b tag mutt ss entb sel_b )
	(if (and
			(setq e (car (mai_entsel T "单选块属性:<退出>" "选择的不是块属性，重选." (list (cons 0 "ATTRIB")) nil)))
			(setq b (entget e))
			(princ (strcat "\n属性 [ " (mai_dxf 2 b) " ] 被选择."))
			(progn
				(setq
					entb (mai_dxf 330 b)
					b (mai_block_name entb)
					tag (cadr (assoc e (mai_get_blk_atts entb T)))
					mutt (getvar 'NOMUTT)
				)
				(princ (strcat "\n选择块 [ " b " ]:<回车全选>"))
				(setvar 'NOMUTT 1)
				(setq
					ss (list (cons 0 "INSERT") (cons 66 1))
					ss (cond
							((ssget ss))
							((ssget "_X" ss))
						)
					ss (vl-remove-if-not '(lambda(x)(= b (mai_block_name x))) (mai_ssget_2_list ss))
				)
				(setvar 'NOMUTT mutt)
				ss
			)
		)
		(list e (mai_list_2_ssget ss) tag)
	)
)


;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

; (defun LM:Selectif ( foo fun str / e )
	; (while
		; (progn
			; (setvar 'ERRNO 0)
			; (setq e (car (fun str)))
			; (cond
				; (	(= 7 (getvar 'ERRNO))
					; (princ "\n** Missed, Try again **")
					; (princ "\n** 没选到，再选 **")
				; )
				; (	(eq 'ENAME (type e))
					; (if (and foo (not (foo e)))
						; (princ "\n** Invalid Object Selected **")
						; (princ "\n** 选择了错误的实体 **")
					; )
				; )
			; )
		; )
	; )
	; e
; )

;;--------------------=={ Block Name }==----------------------;;
