[编程交流] 更改属性的脚本

Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0
Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"
       attribs(0).Update
       attribs(3).Update
Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       attribs(0).TextString = "0"
       attribs(1).TextString = DashDate
       attribs(2).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(0).Update
       attribs(1).Update
       attribs(2).Update
Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub

;; ====================================================================    ;;
;;                                                                   ;;
;;  CHAT.LSP - The program for change attributes with the chosen       ;;
;;              value in dynamic and ordinary blocks.                   ;;
;;                                                                   ;;
;; ==================================================================== ;;
;;                                                                   ;;
;;  Command(s) to call: CHAT                                           ;;
;;                                                                   ;;
;;  Pick sample attribute for filter creation, and after that select    ;;
;;  blocks containing this attribute. The program will request to enter ;;
;;  replaced value (the specified attribute by default) and if          ;;
;;  attributes are found will highlight blocks and will request         ;;
;;  new value.                                                          ;;
;;                                                                   ;;
;; ====================================================================    ;;
;;                                                                   ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY       ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR      ;;
;;  PARTS OF IT ABSOLUTELY FREE.                             ;;
;;                                                                   ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS AND      ;;
;;  SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY         ;;
;;  OR FITNESS FOR A PARTICULAR USE.                         ;;
;;                                                                   ;;
;; ====================================================================    ;;
;;                                                                   ;;
;;  V1.1, 18th Aug 2008, Riga, Latvia                                      ;;
;;  © Aleksandr Smirnov (ASMI)                                     ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)        ;;
;;                                                                   ;;
;;                                      http://www.asmitools.com       ;;
;;                                     ;;
;; ====================================================================    ;;
(defun c:chat(/ cAtt cBl cTag efNm sStr nLst fSet oVal fLst exLst
          fStr actDoc atLst pLst cFrom cTo sucCnt errCnt wSet)
 (vl-load-com)
 (if
   (and
     (setq cAtt(nentsel "\nPick sample attribute > "))
     (= "ATTRIB"(cdr(assoc 0(entget(car cAtt)))))
     ); end and
   (progn
     (setq actDoc(vla-get-ActiveDocument
           (vlax-get-acad-object))
       cBl(vla-ObjectIDtoObject actDoc
        (vla-get-OwnerID
          (setq cAtt
            (vlax-ename->vla-object(car cAtt)))))
       cTag(vla-get-TagString cAtt)
       sucCnt 0 errCnt 0
       wSet(ssadd)
       ); end setq
     (if(vlax-property-available-p cBl 'EffectiveName)
   (progn
     (setq fStr(vla-get-EffectiveName cBl)
       nLst(mapcar 'vla-get-Name
              (vl-remove-if-not
                (function(lambda(x)
              (equal fStr(vla-get-EffectiveName x))))
                    (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp 
                                (mapcar 'cadr(ssnamex
                      (ssget "_X" '((0 . "INSERT")
                    (66 . 1)(2 . "`*U*,")))))))))
       ); end setq
      (foreach n nLst
        (if(not(member n exLst))
            (setq fStr(strcat "`" n "*," fStr)
              exLst(cons n exLst)
              ); end setq
          ); end if
        ); end foreach
     (setq fLst(list '(0 . "INSERT")(cons 2 fStr)))
     ); end progn
   (setq fLst(list '(0 . "INSERT")(cons 2(vla-getName cBl))))
   ); end if
     (princ "\n<<< Select blocks >>> ")
     (if(setq fSet(ssget fLst))
   (progn
     (princ(strcat "\n" (itoa(sslength fSet)) " block(s) found. "))
       (setq cFrom(getstring T
            (strcat "\nChange from <"
                (setq oVal(vla-get-TextString cAtt)) ">: ")))
     (if(= "" cFrom)(setq cFrom oVal))
     (foreach b(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp 
                                (mapcar 'cadr(ssnamex fSet))))
       (setq atLst(vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes b))))
       (foreach at atLst
            (if(and
              (equal(vla-get-TagString at)cTag)
              (equal(vla-get-TextString at)cFrom)
             ); end and
            (progn
              (setq pLst(cons at pLst))
              (ssadd(vlax-vla-object->ename b)wSet)
            ); end progn
          ); end if
         ); end foreacn
       ); end foreach
     (if(/= 0(length pLst))
       (progn
         (princ
       (strcat "\n" (itoa(length pLst)) " attribute(s) found. ")
       ); end princ
         (sssetfirst nil wSet)
         (if
           (and
             (setq cTo(getstring T "\nChange to: "))
             (/= "" cTo)
             ); end and
           (progn
        (sssetfirst nil nil)
            (vla-StartUndoMark actDoc)
             (foreach a pLst
                (if(vl-catch-all-error-p
                 (vl-catch-all-apply 'vla-put-TextString
                     (list a cTo)))
                  (setq errCnt(1+ errCnt))
                  (setq sucCnt(1+ sucCnt))
                  ); end if
               ); end foreach
            (princ
              (strcat "\n" (itoa sucCnt) " of "
              (itoa(length pLst))" attributes changed. ")
          ); end princ
        (if(/= 0 errCnt)
          (princ(strcat(itoa errCnt) " were on locked layer! "))
          ); end if
        (vla-EndUndoMark actDoc)
        ); end progn
       ); end if
     ); end progn
       (princ
         (strcat "\nCan't to find attributes with '"
             cFrom "' value!"))
       ); end if
     ); end progn
   ); end if
     ); end progn
   (princ "\n It isn't attribute  ")
   ); end if
 (princ)
 ); end of c:chatt
(princ "\n*** Type CHAT for change of attributes with the chosen value. ***")
         

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"
       attribs(0).Update
       attribs(3).Update
Next Cntr