将对象移动到新层

woodman78 · 发表于 2022-7-6 11:53:38

我有一个lisp，我拼凑在一起，得到一个dxf输出，并将其重新排列到一组标准层上。

我得到了一个错误，但我想知道是否有人可以写得更有效？？

谢谢

 
(defun c:DoerVer(/)
(command "_.-layer" "_N" "CCC_DOER_LA0001" "_M" "CCC_DOER_LA0001" "_C" "253" "CCC_DOER_LA0001" "_LW" "0.3" "CCC_DOER_LA0001" "" )
(command "_.-layer" "_N" "CCC_DOER_LA0002" "_M" "CCC_DOER_LA0002" "_C" "7" "CCC_DOER_LA0002" "_LW" "0.3" "CCC_DOER_LA0002" "" )
(command "_.-layer" "_N" "CCC_DOER_LA0003" "_M" "CCC_DOER_LA0003" "_C" "84" "CCC_DOER_LA0003" "_LW" "0.3" "CCC_DOER_LA0003" "" )
(command "_.-layer" "_N" "CCC_DOER_LA0004" "_M" "CCC_DOER_LA0004" "_C" "1" "CCC_DOER_LA0004" "_LW" "0.3" "CCC_DOER_LA0004" "" )
(command "_.-layer" "_N" "CCC_DOER_LA0005" "_M" "CCC_DOER_LA0005" "_C" "2" "CCC_DOER_LA0005" "_LW" "0.3" "CCC_DOER_LA0005" "" )
(command "_.-layer" "_N" "CCC_DOER_LA0006" "_M" "CCC_DOER_LA0006" "_C" "7" "CCC_DOER_LA0006" "_LW" "0.3" "CCC_DOER_LA0006" "" )
(command "_change" "all" ""  "p" "layer" "CCC_DOER_LA0006" "" )
(setq blue(ssget "x" '((62 . 5))))
(command "_change" blue ""  "p" "layer" "CCC_DOER_LA0001" "color" "bylayer" "")
(setq magenta(ssget "x" '((62 . 6))))
(command "_change" magenta ""  "p" "layer" "CCC_DOER_LA0002" "color" "bylayer" "")
(setq green(ssget "x" '((62 . 3))))
(command "_change" green ""  "p" "layer" "CCC_DOER_LA0003" "color" "bylayer" "")
(setq red(ssget "x" '((62 . 1))))
(command "_change" red ""  "p" "layer" "CCC_DOER_LA0004" "color" "bylayer" "")
(setq yellow(ssget "x" '((62 . 2))))
(command "_change" yellow ""  "p" "layer" "CCC_DOER_LA0005" "color" "bylayer" "")
(setq text1(ssget "x" '((8 . "TEXT"))))
(command "_change" text1 ""  "p"  "color" "bylayer" "") 
(princ)
)

Lee Mac · 发表于 2022-7-6 12:02:43

不确定这是否是将数据制成表格的最佳方式，但它应该比您使用的更快。

copy


(defun c:DoerVer (/ *error* Make_Layer Layers obj ss tag)
 (vl-load-com)
 
 
 (setq Layers
     ; Old Color    ; New Layer     ; Layer Color ; Layer Lineweight
        '((5   . ("CCC_DOER_LA0001"     253          "030"))
          (6   . ("CCC_DOER_LA0002"       7          "030"))
          (3   . ("CCC_DOER_LA0003"      84          "030"))
          (1   . ("CCC_DOER_LA0004"       1          "030"))
          (2   . ("CCC_DOER_LA0005"       2          "030"))
          (nil . ("CCC_DOER_LA0006"       7          "030")))
 )
 (setq *doc* (cond (*doc*) ((vla-get-ActiveDocument
                              (vlax-get-acad-object)))))
 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))  
 (defun Make_Layer (lay Col LnW)
   (cond (  (tblsearch "LAYER" lay))
          
         (  (setq lObj (vla-add (vla-get-Layers *doc*) lay))
            (vla-put-color lObj Col)
            (vla-put-lineweight lObj
              (eval (read (strcat "acLnWt" LnW)))))))
 (mapcar
   (function
     (lambda (x) (apply (function Make_Layer) (cdr x)))) Layers)
 (if (ssget "_X")
   (progn
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc*))
       
       (if (setq tag (assoc (vla-get-color obj) Layers))
         (mapcar
           (function
             (lambda (x y) (vlax-put-property obj x y))) '(color layer)
           (list acByLayer (cadr tag))))
       (if (eq "TEXT" (vla-get-layer obj))
         (vla-put-color obj acByLayer)))
     (vla-delete ss)))
 (princ))

woodman78 · 发表于 2022-7-6 12:18:48

谢谢你，李。这很管用。另一件事，我正在应用lisp的输出文件的一部分创建了两条垂直间距始终为2.25个单位的绿线。我包括dxf以了解我的意思。它们都是相同的颜色。是否可以选择较低的线并将其移动到层CCC\u DOER\u LA0005。这是一个很长的部分。

我还为一组横截面运行了此lisp的修改版本。每个横截面也包含两条绿线。是否可以扫描图形并将较低的绿线移动到要关闭的单独图层？？

谢谢