[编程交流] 更改对象/图元线型

(defun c:test (/ ly ss)
 ;; Tharwat 06.May.2014  ;;
 ;; altered for list-of-lists approach by Kent Cooper 14 May 2014 ;;
 (setq ly '(("Layer1" 0.5) ("Layer2" 0.75) ("Layer3" 1.5)))
 (if
   (setq ss
     (ssget "_X"
       (list
         '(0 . "CIRCLE,ARC,ELLIPSE,*LINE,RAY,HATCH,REGION")
           ;; [added RAY,HATCH,REGION (people should avoid Hatching on non-continuous-linetype
           ;; Layers, but they do honor linetypes and linetype scale) -- any other possibilities? Leaders
           ;; and Dimensions honor linetypes, but for some reason not linetype scale.]
         (cons 8 (apply 'strcat (mapcar '(lambda (u) (strcat (car u) ",")) ly)))
       ); list
     ); ssget
   ); setq
   ( (lambda (i / sn v)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (if (vlax-write-enabled-p (setq v (vlax-ename->vla-object sn)))
           (vla-put-linetypescale v (cadr (assoc (cdr (assoc 8 (entget sn))) ly)))
         ); if
       ); while
     ); lambda
     -1
   )
 ); if
 (princ)
); defun
(vl-load-com)