[编程交流] 纹理到层旋转问题

;code for changing layer color
;; local defun
;; create a single list of strings interactively
(defun list_of_strings (msg1 msg2 / str_list)
(setq loop T)
(setq st (getstring T msg1)
str_list (cons st str_list))
(while 
(not (eq "" (setq st (getstring T msg2))))
(setq str_list (cons st str_list))
(if (eq st "")(setq loop nil) 
)
)
(reverse str_list)
)
;; by gile
;; convert string to list of strings
(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
     (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)
;; ========== main programm ==========;; 
(defun C:texture(/ common_list curLay data_list fLst laySet sSet mLst cMat sCnt lCnt mCnt eCnt)
(vl-load-com)
(setq common_list
(list_of_strings
"\nEnter first layer name and material separated by comma: "
"\nEnter the next layer name and material separated by comma (or press ENTER to stop): "))
(setq data_list (mapcar (function (lambda(x)(str2lst x ","))) common_list))
 (vl-load-com)
 
(if(setq sSet(ssget "_X" '((0 . "*POLYLINE,*SOLID"))))
 (progn
   (setq sCnt 0 lCnt 0)
   (vlax-for mat (vla-get-Materials
              (vla-get-ActiveDocument
            (vlax-get-acad-object)))
     (setq mLst(cons(vla-get-Name mat)mLst))
     ); end vlax-for
   (foreach itm
       (mapcar 'vlax-ename->vla-object 
         (vl-remove-if 'listp 
           (mapcar 'cadr(ssnamex sSet))))
         (if(setq cMat
           (cadr
             (assoc
               (setq cLay(vla-get-Layer itm))data_list)))
       (if(member cMat mLst)
         (if(vl-catch-all-error-p
              (vl-catch-all-apply 'vla-put-Material
            (list itm cMat)))
           (setq lCnt(1+ lCnt))
           (setq sCnt(1+ sCnt))
           ); end if
         (if(not(member cMat mCnt))
          (setq mCnt(cons cMat mCnt))
           ); end if
         ); end if
       (if(not(member cLay eCnt))
         (setq eCnt(cons cLay eCnt))
         ); end if
          );end if
       ); end foreach
   (if(or(/= 0 lCnt)(/= 0(length mCnt))(/= 0(length eCnt)))
     (progn
   (princ "\n========================= ERROR LIST =========================\n")
   (if(/= 0(length mCnt))
     (progn
       (princ "\nFollowing materials missed in drawing: \n")
       (foreach mat mCnt
         (princ(strcat "\n " mat))
         ); end foreach
       (princ "\n")
       ); end progn
     ); end if
      (if(/= 0(length eCnt))
     (progn
       (princ "\nSome solid layers missed in list: \n")
       (foreach lay eCnt
         (princ(strcat "\n " lay))
         ); end foreach
       (princ "\n")
       ); end progn
     ); end if
    (if(/= 0 lCnt)
      (princ(strcat "\n" (itoa lCnt) " were on locked layer!\n"))
     ); end if
   (princ "\n========================== END LIST ==========================\n")
   (textscr)
   ); end progn
     ); end if
         (princ(strcat "\n<<< Materials are appropriated for "
             (itoa sCnt) " of "
             (itoa(sslength sSet)) " solids >>>"))
   ); end progn
 (princ "\n<!> No Solids Found <!> ")
 ); end if
 (princ)
 )