将每个实体放入

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 (assoc  8 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 (assoc  8 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

写得很快：

copy

(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
                       (cons  8 (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

我的代码独立于您发布的代码，它将提示用户进行选择，将对象移动到单独的层，并更改这些层的颜色。

李

[编程交流] 将每个实体放入

发表回复

精选推荐