下线过滤器故障-can和#03

noochstyle · 发表于 2022-7-5 15:47:47

您好-

这是更大的清理图形脚本的一部分，但由于某些原因，它无法关闭基于过滤器的图层。任何意见都会很好，我认为这对我来说是一个超级简单的混乱。。。。但是我找不到。

它确实调用了程序中其他一些运行良好的lisp例程。


(DEFUN C:XCLEAN        ()        ;         Defines Command Prompt Function Name
(Prompt "\n***  Working, Please wait purge and auditting drawing......\n")        ;        Feedback to user
(getvar "cmdecho")        ;        Get cmd echo variable status
(setvar "cmdecho" 0)        ;        Turn off command line
(getvar "Nomutt")        ;        Get Nomutt variable status
(setvar "Nomutt" 1)        ;        Turn off command line
;;        UNLOCK ALL        ;;
(command "-layer" "ON" "*" "thaw" "*"        "u" "*" "color" "t" "255,0,255"        "*" \e )        ;         All layers on, unfrozen and unlock all layers, set color to magenta of all layers
;;        DELETE ALL DIMENSIONS        ;;
         (command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "")
;;        SPECIALIZED BURST - SEE SCRIPTS BELOW ;;
(C:DEMO)
(C:DEMO)
(C:DEMO)
;; DELETE ALL LAYOUTS        ;;
(vl-load-com)
(setq layouts
(vla-get-layouts
(vla-get-activedocument (vlax-get-acad-object))
)
)
(mapcar '(lambda (layout)
(vla-delete (vla-item layouts layout))
)
(layoutlist)
)
        
;;        DELETE ALL DIMENSIONS        ;;
         (command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "")
;; SET ALL TO BY LAYER        
(command "LAYON" "LAYTHW" "SETBYLAYER" "ALL" "" "Y" "Y")        ;        SET ALL TO BY LAYER
;;        PURGE AND AUDIT        ;;
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
(command "tilemode" "1")        ;         Makes Model Space Current
(command "zoom" "e")        ;         Zoom Extents
(command "tilemode" "0")        ;         Makes Paper Space Current
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
(command "zoom" "e")        ;         Zoom Extents
(command "_qsave")        ;         Save File
(command "tilemode" "1")        ;         Makes Model Space Current
(command "-purge" "All" "*" "N")        ;         Purge all unused
(command "-UNITS" "4" "16" "1" "0" "90" "N" \e)        ;         Sets unit Architectual, 1/16" Precision, Decimal Degrees with no decimal spaces, Angle Zero at top of screen                        
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
(command "-purge" "All" "*" "N" \e)        ;        Purge all unused
  ;;        CHANGE ALL HATCH TO COLOR 8
(command "_.chprop"
(ssget "x" (list (cons 0 "HATCH")))
""
"Color"
8
""
)        
[color="red"]           ;;        TURN OFF SPECIFIC LAYERS
(command "-LAYER" "OFF" "*WALL-IDEN*" \e)
(command "-LAYER" "OFF" "*DOOR-IDEN*" \e)
(command "-LAYER" "OFF" "*DIMS*,*DEFPOINT*" \e)[/color]
;;        SET TO COLOR 8 BY LAYER Name
(command "-LAYER" "COLOR" 8 "*TREE*,*BUSH*,*PLANTS*" \e)
(command "-LAYER" "COLOR" 8 "*LTS*,*LITE*,*LIGHT*" \e)
(command "-LAYER" "COLOR" 8 "*FURN*,*DETL*" \e)
(command "-LAYER" "COLOR" 8 "*CURB*,*PARK*" \e)
(command "-LAYER" "COLOR" 8 "*PITCH*,*SLOPE*" \e)
(command "-LAYER" "COLOR" 8 "*GRID*" \e)
(command "-LAYER" "COLOR" 8 "*ANNO*,*IDEN*,*PATT*" \e)
(command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "")        
(command "_qsave")        ;         Save File
(setvar "Nomutt" 0)        ;        Turn on command line
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******************************************\n")        ;        Feedback to user
(Prompt "\n******* XCLEAN SCRIPT COMPLETE        *********\n")        ;        Feedback to user
(gc)        ;        Free ram resources
)

ronjonp · 发表于 2022-7-5 15:53:57

尝试使用冻结？这是我的工作：（命令“-LAYER”“FREEZE”“*WALL-IDEN*“nil）

noochstyle · 发表于 2022-7-5 16:03:27

这是可行的，只是奇怪的是关没有，但“冻结”有。。。。

在这种情况下，nil和e之间应该没有区别，对吗？

谢谢你！！！应该用那个部分打开。

ronjonp · 发表于 2022-7-5 16:09:36

我从未在命令调用中使用过e，因此不知道它们是否相同。这一层的大部分内容可以在没有任何命令的情况下实现自动化。下面是更改图层颜色的快速示例：

copy

(vl-load-com)
(defun layer2color (pattern color / n)
 (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
   (if        (wcmatch (setq n (strcase (vla-get-name l))) (strcase pattern))
     (vla-put-color l color)
   )
   (princ)
 )
)
(layer2color
 "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*"
 8
)
(defun layer2colorvanilla (pattern color / e l n)
 (while (setq l (tblnext "layer" (null l)))
   (and (setq n (cdr (assoc 2 l)))
 (wcmatch (strcase n) (strcase pattern))
 (setq e (tblobjname "layer" n))
 (setq e (entmod (append (entget e) (list (cons 62 color)))))
   )
 )
 (princ)
)
(layer2colorvanilla
 "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*"
 8
)

不客气

noochstyle · 发表于 2022-7-5 16:10:29

copy


(defun layer2colorvanilla (pattern color / e l n)
 ;; Make mask layer colors 255,255,255
 (while (setq l (tblnext "layer" (null l)))
   (and (setq n (cdr (assoc 2 l)))
 (wcmatch (strcase n) (strcase pattern))
 (setq e (tblobjname "layer" n))
 (setq e (entmod (append (entget e) (list (cons 62 color)))))
   )
 )
 (princ)
)
(layer2colorvanilla
 "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*"
 8
)

这非常有效，并且可能比传递命令更快地进行更改。我真的不理解掩蔽部分。我在第一部分中使用了相同的定义，但在“香草”部分（就像名字选择一样，哈哈）。

我只是用这个传递它：

copy


(vl-load-com)
(defun layer2color (pattern color / n)
(vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
   (if        (wcmatch (setq n (strcase (vla-get-name l))) pattern)
(vla-put-color l color)
   )
   (princ)
)
)
(layer2color
"*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*,*GENM*"
8
)

ronjonp · 发表于 2022-7-5 16:19:11

还有一些需要仔细考虑
掩码注释是我为不同代码准备的。。你可以忽略它。

copy

(defun c:layerschtuff (/ doc n s)
 ;; To modelspace
 (setvar 'tilemode 1)
 (vlax-for l (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object))))
   ;; Unlock layers
   (vl-catch-all-apply 'vla-put-lock (list l :vlax-false))
   ;; Color magenta
   (vla-put-color l 6)
   (setq n (strcase (vla-get-name l)))
   ;; Color 8
   (if
     (wcmatch
n
"*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*"
     )
      (vla-put-color l 
   )
   ;; Freeze layers
   (if        (wcmatch n "*WALL-IDEN*,*DOOR-IDEN*,*DIMS*,*DEFPOINT*")
     (vl-catch-all-apply 'vla-put-freeze (list l :vlax-true))
   )
 )
 ;; Delete dims and leaders
 (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s))))
 ;; Delete layouts
 (vlax-for l (vla-get-layouts doc) (vl-catch-all-apply 'vla-delete (list l)))
 (princ)
)
(c:layerschtuff)

noochstyle · 发表于 2022-7-5 16:21:35

使用VBA/Activex代替传递命令是否更有效？

mapcar是否会使删除维度在所有实体中递归，或者需要多次运行该命令以在突发后消除突发实体中的这些维度？

你要把我整只编码兔送下去，哈哈。

ronjonp · 发表于 2022-7-5 16:29:00

我喜欢不使用命令调用的地方是在AutoCAD版本之间工作的代码的一致性。。是的，通常速度要快得多。至于在爆炸后删除DIM，你需要在爆炸时重复x次。。差不多吧。

copy

 ;; Repeat 10 times exploding block and deleting dims
(repeat 10
   (and (setq s (ssget "_X" '((0 . "insert") (410 . "Model")))) (command "_.explode" s))
   (and (setq s (ssget "_X" '((0 . "DIMENSION,LEADER") (410 . "Model"))))
 (mapcar 'entdel (mapcar 'cadr (ssnamex s)))
   )
 )

我希望如此。。一旦你开始理解代码，它就会变得非常上瘾！

noochstyle · 发表于 2022-7-5 16:33:01

重复命令太酷了！肯定不知道那件事。你把我的一段代码重新写成了更好的格式。。。。非常感谢。我想我也可以在清除命令中使用repeat。我正在考虑在最后一次清除之前运行dim delete例程。我只是想通过删除尽可能多的不需要的东西来加快速度。

noochstyle · 发表于 2022-7-5 16:41:17

好的，我被卖了。

copy

(vla-purgeall (vla-get-activeDocument (vlax-get-acad-object)))

安静且速度快于：

copy

(command "-purge" "All" "*" "N" nil)

[编程交流] 下线过滤器故障-can和#03

发表回复

精选推荐