ADSK2007 发表于 2022-7-6 08:16:57

将每个实体放入

大家好
 
我一直在使用lisp rutine将每个实体对象放在一个单独的层上，以便导出到另一个应用程序。lisp很好用，但它只为所有层指定一种颜色（红色）。有没有办法对每一层应用随机颜色？下面是我做这件事的常规。
 
谢谢你的帮助
 

(defun C:l2l (/ a lname b index b1 name n)
(setvar "regenmode" 0)
(setq a (ssget))
(setq lname "3d" )
(setq b 1)
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (1+index))
(setq b2 (rtos b 2 0))
(setq na (strcat lname b2))
(command "layer" "n" na "" "")
(command "layer" "s" na "c" 1 "" "s" 0 "")
(setq c (assoc8 b1))
(setq d (cons (car c)na))
   (setq e (subst d c b1))
   (entmod e)
;   (command "change" !b1 "")
;   (command "change" "p" "" "p" "la" na "" "")
(setq b (1+b))
)
(setvar "regenmode" 1)
)
(defun C:l2lA (/ a lname b index b1 name n)
(setvar "regenmode" 0)
(setq a (ssget))
(setq lname (getstring "\Enter the starting string (A MAXIMUM OF 5 CHARACTERS): "))
(setq b 1)
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (1+index))
(setq b2 (rtos b 2 0))
(setq na (strcat lname b2))
(command "layer" "n" na "" "")
(command "layer" "s" na "c" 1 "" "s" 0 "")
(setq c (assoc8 b1))
(setq d (cons (car c)na))
   (setq e (subst d c b1))
   (entmod e)
;   (command "change" !b1 "")
;   (command "change" "p" "" "p" "la" na "" "")
(setq b (1+b))
)
(setvar "regenmode" 1)
)

Lee Mac 发表于 2022-7-6 08:38:32

写得很快：
 
(defun c:Solids2Layers ( / _padzeros a b e i l n p s )
   (setq p "3d")

   (defun _padzeros ( s l )
       (if (< (strlen s) l) (_padzeros (strcat "0" s) l) s)
   )
   (if (setq s (ssget "_:L" '((0 . "*SOLID"))))
       (progn
         (setq
               i (sslength s)
               l (1+ (fix (/ (log i) (log 10))))
               n 0
         )
         (repeat i
               (setq e (entget (ssname s (setq i (1- i)))))
               (entmod
                   (subst
                     (cons8 (strcat p (_padzeros (itoa (setq n (1+ n))) l)))
                     (assoc 8 e)
                     e
                   )
               )
         )
         (setq n 0)
         (while (setq a (tblnext "LAYER" (null a)))
               (if (wcmatch (setq b (cdr (assoc 2 a))) (strcat p "*"))
                   (entmod
                     (setq b (entget (tblobjname "LAYER" b))
                           b (subst (cons 62 (setq n (1+ (rem n 254)))) (assoc 62 b) b)
                     )
                   )
               )
         )
       )
   )
   (princ)
)

ADSK2007 发表于 2022-7-6 09:06:38

嗨，李
 
谢谢你的帮助。一个问题。在我使用L2L例程之后，我需要使用lisp吗？或者你的代码也会选择实体，并将它们全部放在具有不同层名称和颜色的单独层中？此外，是否可以将代码添加到原始lisp例程中？
 
再次感谢你的帮助。
 
ADSK公司

Lee Mac 发表于 2022-7-6 09:34:25

我的代码独立于您发布的代码，它将提示用户进行选择，将对象移动到单独的层，并更改这些层的颜色。
 
李
页: [1]
查看完整版本: 将每个实体放入