单独绘制每个图层

Grrr · 发表于 2022-7-5 16:14:31

你好
我正在寻找一个lisp例程，它将在名为“Plan1”的布局中绘制每个层，
因此，对于布局中的N个可见层，将创建N个打印文件（每个打印文件仅包含一个单独的层）。
我的目标是稍后将其中一些合并并在photoshop中使用。

Tharwat · 发表于 2022-7-5 16:21:33

你好

你能详细介绍一下你的计划目标吗？

Grrr · 发表于 2022-7-5 16:25:23

嗨，塔瓦，
目前，我正在使用这样的东西：

   (setq curTAB (getvar CTAB)
  (setvar CTAB "Plan1")
  (command "-layer" "off" "*" "Y" "")
  (command "-layer" "on" "LAYER1,LAYER2" "")        ;;;;PLOTS SPECIFIED LAYERS
  (COMMAND  "-PLOT" "N" "" "" "" "" "N" "Y")
  (command "-layer" "on" "*" "")
  (setvar CTAB curTAB)

但我不知道如何对每个层重复这个过程（关闭所有层，在打开一个层的情况下执行打印，然后在layerstable中对下一个层执行此操作）。

也许最好先获取图层的打印状态（如果其“关闭”或“不可打印”）以跳过它，这样就可以避免使用备用（空）打印文件。

Tharwat · 发表于 2022-7-5 16:28:18

这应该会给你一个推动

copy


(setq lay (getvar 'CTAB))
(foreach layout (layoutlist)
 (setvar 'CTAB layout)
 (while (setq item (tblnext "LAYER" (null item)))
   (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 item)))))
   (cond ((minusp (cdr (assoc 62 eng)));; = off
          ;; do something
         )
         ((eq 1 (cdr (assoc 290 eng))) ;; = Not to plot
          ;; do something here
         )
   )
 )
)
(setvar 'CTAB lay)

Grrr · 发表于 2022-7-5 16:32:10

谢谢你，塔瓦！

Tharwat · 发表于 2022-7-5 16:34:53

祝你好运。

Grrr · 发表于 2022-7-5 16:39:06

好吧，我被这个困住了：

copy

(defun C:test (/ lay item eng fnm)
(setq lay (getvar 'CTAB))
(foreach layout (layoutlist)
 (setvar 'CTAB layout)
 (while (setq item (tblnext "LAYER" (null item)))
   (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 item)))))
   (cond ((minusp (cdr (assoc 62 eng)));; = off
         (princ "\nThis layer is off") ;; do something
         )
         ((eq 1 (cdr (assoc 290 eng))) ;; = Not to plot
         (princ "\nThis layer is not plottable") ;; do something here
         )
   )
   (command "-layer" "off" "*" "Y" "")
   (command "-layer" "on" eng "")        ;;;;PLOTS SPECIFIED LAYERS
   (COMMAND  "_.PLOT" "_N" "" "" "" (if (= "" (setq fnm (getstring t "\nNAME OF THE FILE <ASD>:"))) "ASD" fnm) "_N" "_Y")
   (command "-layer" "on" "*" "")
 )
)
(setvar 'CTAB lay)
(princ)
)

我找不到合并这些行的方法：

copy

    (command "-layer" "off" "*" "Y" "")
   (command "-layer" "on" eng "")        ;;;;PLOTS SPECIFIED LAYERS

因此，现在例程关闭所有层，并对每个层执行打印（不打开它）。

Tharwat · 发表于 2022-7-5 16:41:00

你好

我真的没有测试的代码，由于命令阴谋，所以我希望它能满足您的需要
让我知道你的计划进展如何。

copy


(defun c:Test (/ *error* c l lst lay item eng fnm)
 ;; Tharwat 25.01.2016    ;;
 (defun *error* (msg)
   (if lst
     (foreach x lst
       (entmod (append (entget (tblobjname "LAYER" (car x)))
                       (list (cadr x) (caddr x))
               )
       )
     )
   )
   (if lay
     (setvar 'ctab lay)
   )
   (if (and msg (not (wcmatch msg "*CANCEL*,*EXIT*,*BREAK*")))
     (princ (strcat "\n ** Error : " msg " **"))
   )
   (princ)
 )
 (while (setq item (tblnext "LAYER" (null item)))
   (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 item))))
         lst (cons
               (list (cdr (assoc 2 item)) (assoc 62 item) (assoc 290 eng))
               lst
             )
   )
   (if (/= (cdr (assoc 2 l)) "DefPoints")
     (entmod
       (append eng
               (list (cons 290 1)
                     (cons 62
                           (if (minusp (setq c (cdr (assoc 62 item))))
                             (- c)
                             c
                           )
                     )
               )
       )
     )
   )
 )
 (setq lay (getvar 'ctab))
 (foreach layout (layoutlist)
   (setvar 'ctab layout)
   (while (setq l (tblnext "LAYER" (null l)))
     (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 l)))))
     (if (/= (cdr (assoc 2 l)) "DefPoints")
       (progn
         (command "_.-layer" "off" "*" "Y" "")
         (command
           "_.PLOT"
           "_N"
           ""
           ""
           ""
           (if (= ""
                  (setq fnm (getstring t "\nNAME OF THE FILE <ASD>:"))
               )
             "ASD"
             fnm
           )
           "_N"
           "_Y"
         )
         (command "-layer" "on" "*" "")
       )
     )
   )
 )
 (setvar 'ctab lay)
 (*error* nil)
 (princ)
)

Grrr · 发表于 2022-7-5 16:44:36

谢谢你的帮助Tharwat！
但我仍然遇到了这个问题：例程关闭所有层，并对每个层（不打开它）和每个布局执行打印。

如果这有助于简化代码：
我真的不需要它来为每个布局绘图（只指定一个就足够了）。
您可以包括图层表中的所有图层-之间的闭合回路可能存在问题

copy

(cond ((minusp (cdr (assoc 62 eng)));; = off

和

copy

(command "_.-layer" "off" "*" "Y" "")

主要目标是在不同的位置获得每一层上的线条。pdf文件。

Tharwat · 发表于 2022-7-5 16:50:37

像这样的？

注意：根据需要更改程序中布局的名称。

copy


(defun c:test (/ *error* _layout c l lst lay item eng fnm vars)
 ;; Tharwat 25.01.2016    ;;
 
 (setq _layout [color=magenta]"Plan1"[/color])[color=red];; <- name of layout[/color]
 (defun *error* (msg)
   (if lst
     (foreach x lst
       (entmod (append (entget (tblobjname "LAYER" (car x)))
                       (list (cadr x) (caddr x))
               )
       )
     )
   )
   (if vars
     (mapcar 'setvar '(ctab cmdecho clayer) vars)
   )
   (if (and msg (not (wcmatch msg "*CANCEL*,*EXIT*,*BREAK*")))
     (princ (strcat "\n ** Error : " msg " **"))
   )
   (princ)
 )
 (if (member _layout (layoutlist))
   (progn
     (while (setq item (tblnext "LAYER" (null item)))
       (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 item))))
             lst (cons
                   (list (cdr (assoc 2 item))
                         (assoc 62 item)
                         (assoc 290 eng)
                   )
                   lst
                 )
       )
       (if (/= (cdr (assoc 2 l)) "DefPoints")
         (entmod
           (append
             eng
             (list (cons 290 1)
                   (cons 62
                         (if (minusp (setq c (cdr (assoc 62 item))))
                           (- c)
                           c
                         )
                   )
             )
           )
         )
       )
     )
     (setq vars (mapcar 'getvar '(ctab cmdecho clayer)))
     (mapcar 'setvar '(ctab cmdecho) (list _layout 0))
     (setq l nil)
     (while (setq l (tblnext "LAYER" (null l)))
       (setq eng (entget (tblobjname "LAYER" (cdr (assoc 2 l)))))
       (if (/= (cdr (assoc 2 l)) "DefPoints")
         (progn
           (command "_.-layer" "off" "*" "N" "")
           (entmod
             (append
               eng
               (list (cons 290 1)
                     (cons 62
                           (if (minusp (setq c (cdr (assoc 62 l))))
                             (- c)
                             c
                           )
                     )
               )
             )
           )
           (setvar 'clayer (cdr (assoc 2 l)))
           (command
             "_.PLOT"
             "_N"
             ""
             ""
             ""
             (if
               (= ""
                  (setq fnm (getstring t "\nNAME OF THE FILE <ASD>:"))
               )
                "ASD"
                fnm
             )
             "_N"
             "_Y"
           )
           (command "_.-layer" "on" "*" "")
         )
       )
     )
   )
   (princ (strcat "\nLayout < "
                  _layout
                  " > is not found in drawing !"
          )
   )
 )
 (*error* nil)
 (princ)
)

可以从列表中关闭上一层吗？
因此，它将成为每个文件1层：

copy

File 1: Layer1
File 1: Layer2, Layer3
File 2: Layer3, Layer4
File 3: Layer4, Layer5
File 4: Layer5, Layer6
.....
File N: Layer(N-1), LayerN

[编程交流] 单独绘制每个图层

发表回复

精选推荐