;;-----------------=={ 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)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if
    (and
      (setq asel (LM:GetAttribSelection doc t))    
      (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 (vla-get-TagString x)) (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 doc asel base disp ss tag e )
  (mini_start nil)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if
    (and
      (setq asel (LM:GetAttribSelection doc t))
      (setq base
        (trans
          (vlax-get (setq o (car asel))
            (if (and (or (not (vlax-property-available-p o 'MTextAttribute))
                         (eq :vlax-false (vla-get-MTextAttribute o))
                     )
                     (not (eq acAlignmentLeft (vla-get-Alignment o)))
                )
                'TextAlignmentPoint
                'InsertionPoint
            )
          )
          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 (vla-get-tagstring x)) (vla-put-rotation x 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
                   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 (vla-get-ActiveDocument (vlax-get-acad-object))
        TextStyles (acad_strlsort (vlax-for s (vla-get-TextStyles doc) (setq TextStyles (cons (vla-get-Name s) TextStyles))))
        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 doc nil)))
      (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 (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-property o 'TextString)
              (itoa (vl-position (vlax-get-property o 'StyleName) TextStyles))
              (itoa (vl-position (vlax-get-property o 'Alignment) (mapcar 'cdr AlignLst)))
              (rtos (vlax-get-property o 'Height))
              (angtos (vlax-get-property o 'ObliqueAngle))
              (angtos (vlax-get-property 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 )
            (foreach e ss
              (mapcar
                '(lambda ( attrib )
                    (if (eq tag (vla-get-TagString attrib))
                      (mapcar
                        '(lambda ( prop / err tmp )
                            (if (eq (car prop) 'Alignment)
                                (setq tmp (vlax-get-property attrib 'InsertionPoint))
                            )
                            (setq err (vl-catch-all-apply 'vlax-put-property (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-property 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 (vla-get-MTextAttribute y))
                 )
            )               
          )
          nentsel
          "\nÑ¡ÔñÊôÐÔ:"
        )
      )
      (princ (strcat "\n'" (mai_dxf 2 e) "' ±»Ñ¡Ôñ."))
      (setq o (vlax-ename->vla-object e)
            b (mai_block_name (vla-ObjectIDtoObject doc (vla-get-OwnerId o)))
            tag (vla-get-TagString o)
      )
      (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)
  )
)



;;---------------------=={ 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 **")
        )
        ( (eq 'ENAME (type e))

          (if (and foo (not (foo e)))
            (princ "\n** Invalid Object Selected **")
          )
        )
      )
    )
  )
  e
)

;;--------------------=={ Block Name }==----------------------;;
(princ)
