在右侧轻轻推一下

PDuMont · 发表于 2022-7-5 17:21:50

你好

作为练习，我正在lisp中尝试另一种方法。
我用一个列表来检查/创建图层，它让我想到我可以做更多。

  (setq layLst '(
         (("CNC_DRILL-.10-PLEX"      30))
         (("CNC_DRILL-.30-CTRSINK"  241))
         (("CNC_DRILL-.125-PILOT"     9))
         (("CNC_DRILL-.1875-THRU"     4))
         (("CNC_DRILL-.250-PEG"       1))
         (("CNC_DRILL-.250-THRU"      6))
         (("CNC_DRILL-.3125-THRU"     3))
         (("CNC_DRILL-.375-THRU"      6))
         (("CNC_DRILL-.500-THRU"      2))
         (("CNC_PLY-DOWEL"          211))
         (("CNC_PLY-T-NUT-RECESS"     2))
         (("CNC_PLY-GROMMET"         40))
         (("CNC_PLY-SLOT"             1))
        ) ; end comLst
 ) ;_ end of setq
 (foreach itm layLst
   (if        (not (tblsearch "LAYER" (caar itm)))
     (progn
(setq nLay (vla-Add (vla-get-Layers
                      (vla-get-ActiveDocument
                        (vlax-get-acad-object)
                      ) ;_ end of vla-get-ActiveDocument
                    ) ;_ end of vla-get-Layers
                    (caar itm)
           ) ;_ end of vla-Add
) ;_ end of setq
(vla-put-Color nLay (cadar itm))
     ) ; end progn
   ) ; end if
   (command "_.layer"
     "_on" (caar itm)
     "_thaw" (caar itm)
     "_unlock" (caar itm)
     ""
   )
 ) ;_ end of foreach

此例行程序的其余部分（使用cond）检查圆半径，并将圆放置在其相应的层上（使用命令）。如果需要的话，我可以发布整个程序。

我想知道是否可以将半径添加到layLst，并使用foreach语句对照它检查选择集，从而消除多个条件语句。

copy

  (setq        layLst '(
         (("CNC_DRILL-.10-PLEX"      30) 0.10)
         (("CNC_DRILL-.30-CTRSINK"  241) 0.30)
         (("CNC_DRILL-.125-PILOT"     9) 0.125)
         (("CNC_DRILL-.1875-THRU"     4) 0.1875)
         (("CNC_DRILL-.250-PEG"       1) 0.250)
         (("CNC_DRILL-.250-THRU"      6))
         (("CNC_DRILL-.3125-THRU"     3) 0.3125)
         (("CNC_DRILL-.375-THRU"      6) 0.375)
         (("CNC_DRILL-.500-THRU"      2) 0.5)
         (("CNC_PLY-DOWEL"          211))
         (("CNC_PLY-T-NUT-RECESS"     2))
         (("CNC_PLY-GROMMET"         40))
         (("CNC_PLY-SLOT"             1))
        ) ; end comLst
 ) ;_ end of setq

这似乎应该是可能的。

任何帮助都将不胜感激。

PDuMont · 发表于 2022-7-5 17:28:50

这是整个程序，以防我不清楚我想做什么。

copy

(defun C:C2L  (/ *error*
       clay
       oce
       doc
       ss-circle
       ent
       enlist
       cr
       i
       layList
       nLay)
 (defun *error* (msg)
   (if        (and msg
     (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
)
     (princ (strcat "\nError: " msg))
     )
   (if        clay
     (setvar 'clayer clay)
     )
   (if        oce
     (setvar 'cmdecho oce)
     )
   (if doc
     (vla-endundomark doc)
     )
   (princ)
 ) ;_ end of defun
 
 (setq clay (getvar 'clayer)
       oce  (getvar 'cmdecho)
       )
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (setvar 'cmdecho 0)
 
 ;; -----------------------------------------------------------------------------
 ;; |                               CREATE LAYERS                               |
 ;; |                                                                           |
 ;; -----------------------------------------------------------------------------
 (setq        layLst '(
         (("CNC_DRILL-.10-PLEX"      30) 0.10)
         (("CNC_DRILL-.30-CTRSINK"  241) 0.30)
         (("CNC_DRILL-.125-PILOT"     9) 0.125)
         (("CNC_DRILL-.1875-THRU"     4) 0.1875)
         (("CNC_DRILL-.250-PEG"       1) 0.250)
         (("CNC_DRILL-.250-THRU"      6))
         (("CNC_DRILL-.3125-THRU"     3) 0.3125)
         (("CNC_DRILL-.375-THRU"      6) 0.375)
         (("CNC_DRILL-.500-THRU"      2) 0.5)
         (("CNC_PLY-DOWEL"          211))
         (("CNC_PLY-T-NUT-RECESS"     2))
         (("CNC_PLY-GROMMET"         40))
         (("CNC_PLY-SLOT"             1))
        ) ; end comLst
 ) ;_ end of setq
 (foreach itm layLst
   (if        (not (tblsearch "LAYER" (caar itm)))
     (progn
(setq nLay (vla-Add (vla-get-Layers
                      (vla-get-ActiveDocument
                        (vlax-get-acad-object)
                      ) ;_ end of vla-get-ActiveDocument
                    ) ;_ end of vla-get-Layers
                    (caar itm)
           ) ;_ end of vla-Add
) ;_ end of setq
(vla-put-Color nLay (cadar itm))
     ) ; end progn
   ) ; end if
   (command "_.layer"
     "_on" (caar itm)
     "_thaw" (caar itm)
     "_unlock" (caar itm)
     ""
   )
 ) ;_ end of foreach
 
 ;; -----------------------------------------------------------------------------
 ;; |                               MAIN PROGRAM                                |
 ;; |                                                                           |
 ;; -----------------------------------------------------------------------------
 (prompt "\nSelect Entities to be Changed : ")
 (if (setq ss-circle
            (ssget
              '(
                (-4 . "<OR")
                (0 . "CIRCLE")
                (-4 . "<AND")
                (0 . "LWPOLYLINE")
                (42 . 1.0)
                (-4 . "AND>")
                (-4 . "OR>")
                )
              )
           )
   (progn
     (setq i -1)
     (while (setq ent (ssname ss-circle (setq i (1+ i))))
       (setq enlist (entget ent))
(setq cr (cdr (assoc 40 enlist)))
       (if (eq (cdr (assoc 0 enlist)) "LWPOLYLINE")
  (if (equal 2.17691944 (vlax-curve-getarea ent) 1e-6)
    (command "change" ent "" "property" "layer" "CNC_PLY-SLOT" "")
  )
  (cond
    ((equal cr 0.0625 0.00001)     ;1/8" PILOT  DRILL
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.125-PILOT" "")
            )
           ((equal cr 0.09375 0.00001) ;3/16" DRILL
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.1875-THRU" "")
            )
           ((equal cr 0.125 0.00001)   ;1/4" DRILL BLIND
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.250-PEG" "")
            )
           ((equal cr 0.15625 0.00001) ;5/16" DRILL
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.3125-THRU" "")
            )
           ((equal cr 0.1875 0.00001)  ;3/8" DRILL
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.375-THRU" "")
            )
           ((equal cr 0.25 0.00001)    ;1/2" DRILL
            (command "change" ent "" "property" "layer"
                     "CNC_DRILL-.500-THRU" "")
            )
    ((and (>= cr 0.375) (<= cr 0.49)) ;DOWELS
            (command "change" ent "" "property" "layer"
                     "CNC_PLY-DOWEL" "")
            )
           ;|((equal cr 0.3750 0.00001)  ;3/4" DOWEL PINS
            (command "change" ent "" "property" "layer"
              "CNC_PLY-DOWEL" "")
            )|;
           ((equal cr 0.453125 0.000001) ;29/32" HOLE LOCK IN DOOR
            (command "change" ent "" "property" "layer"
              "CNC_PLY-DOWEL" "")
            )
           ;|((equal cr 0.4375 0.00001)  ;7/8" RECESS FOR T-NUT
            (command "change" ent "" "property" "layer"
                     "CNC_PLY-T-NUT-RECESS" "")
            )|;
           ((and (>= cr 0.375) (<= cr 0.625))   ;RECESS FOR T-NUT
            (command "change" ent "" "property" "layer"
                     "CNC_PLY-T-NUT-RECESS" "")
            )
           ((equal cr 0.52343750 0.00001)  ; 1 3/64" HOLE PUSH LOCK IN DOOR
            (command "change" ent "" "property" "layer"
              "CNC_PLY-DOWEL" "")
            )
           ((and (>= cr 0.563) (<= cr 2.5)) ;GROMMETS
            (command "change" ent "" "property" "layer"
                     "CNC_PLY-GROMMET" "")
            )
           ) ;_cond
         ) ;_if
       (princ)
       )
     )
   )
 (vla-endundomark doc)
 (setvar 'cmdecho oce)
 (setvar 'clayer  clay)
 (princ)
 )

Tharwat · 发表于 2022-7-5 17:37:12

嗨，塔尔瓦特。

嗯，因为我不知道我在做什么？

你是对的，我遵循了我使用的reactor lisp的语法，但我现在明白了这是没有必要的。

我的下一个问题是，如何将选择集传递给列表？
我确信我被一些简单的事情困住了。

除了减少键入之外，这种方法还有什么好处吗？

谢谢Tharwat！

PDuMont · 发表于 2022-7-5 17:43:52

嗨，菲利普，

对不起，将选择集传递给列表是什么意思？

Tharwat · 发表于 2022-7-5 17:55:08

copy


(setq layLst '(
              ("CNC_DRILL-.10-PLEX" 30 0.10)
              ("CNC_DRILL-.30-CTRSINK" 241 0.30)
             )
)

如何将foreach语句包含在ssget中？

我可能没有任何意义。。。

PDuMont · 发表于 2022-7-5 17:59:58

我认为这是一种不好的编程方式，但用圆创建一个选择集，然后用cond函数检查每个圆的半径，就像你在post#2中的代码中使用的那样，要好得多。

Tharwat · 发表于 2022-7-5 18:03:04

我在想这可能不是一个好处。。。

多谢塔瓦。

PDuMont · 发表于 2022-7-5 18:08:55

非常欢迎菲利普，如果你需要帮助，请告诉我。

Tharwat · 发表于 2022-7-5 18:20:47

如果可以使用第n个x直接在laylst中查看半径，如果匹配，则更改层，那么唯一可能有助于减少conds的事情需要仔细考虑。A repeat=sslength实体。

copy

(foreach itm layLst

BIGAL · 发表于 2022-7-5 18:26:17

[编程交流] 在右侧轻轻推一下

发表回复

精选推荐