删除当前CAD文档中除STANDARD以外的所有多线样式

guosheyang

      给朋友们共享个自定义函数，删除当前CAD文档中除STANDARD以外所有未被使用的且非当前的多线样式 ，本代码功能也可以用pu命令来实现，这里仅作为供初学多线样式编码的学习资料，请大家测试 ，有问题请反馈   谢谢！

;删除当前CAD文档中除STANDARD以外的所有未被使用的且非当前多线样式
;参数：无                                    
;执行 (ygs_Keep_only_STD)                     


(defun ygs_Keep_only_STD(/ MLST_EN MLTY SS-ML YSM YSM2 YSMB)
;提取多线样式对象图元名
(setq mlst_en
   (mapcar 'cdr
   (vl-remove-if-not
  '(lambda (x) (eq(car x)350))
   (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
   )
  )
)
(setq ss-ml(ssget "x" '((0 . "MLINE"))));多线图元选择集
(if ss-ml
(progn
  (setq mlty(ss2tym ss-ml));多线图元
  (setq ysmb nil);样式名表
  (while(car mlty)
      (if(not(member(setq ysm(cdr(assoc 2(entget (car mlty))))) ysmb))
         (setq ysmb(cons ysm ysmb))      
      )
    (setq mlty(cdr mlty))
  )
)
)
(setvar 'CMLSTYLE "STANDARD")
(foreach x mlst_en;删除standard以外的多线样式图元
  (IF(and
      (/= (setq ysm2(cdr(assoc 2(entget x)))) "STANDARD");(car mlst_en)
      (not(member ysm2 ysmb))
     )
    (ENTDEL x)
  )
)
)
;;;选择集转图元名表（ss是否存在 可加个if判断下）
(defun ss2tym(ss / i L)
  (repeat (setq i (sslength ss))
   (setq L (cons (ssname ss (setq i (1- i))) L))
  )
(reverse L)
)

自贡黄明儒

如果 已经使用，能删除么？

guosheyang

自贡黄明儒 发表于 2022-8-3 15:55
如果 已经使用，能删除么？

好像不行的   要空的才行

guosheyang

刚才试了下   没用的空样式  直接用pu命令也是可以清理掉的

月下闲人

自贡黄明儒 发表于 2022-8-3 15:55
如果 已经使用，能删除么？

黄工好，请教怎么一键将文件standard样式置为当前（文字、标注、表格、多重引线），感谢

自贡黄明儒

月下闲人 发表于 2024-1-8 15:59
黄工好，请教怎么一键将文件standard样式置为当前（文字、标注、表格、多重引线），感谢

(defun do2 (DimS)
    (if        (setq e (entsel "\n 拾取标注，设置为当前标注样式:"))
      (progn
        (setq e (car e))
        (princ "...当前标注样式为:")
        (princ
          (setq CurDim (vla-get-StyleName (vlax-ename->vla-object e)))
        )
        (vla-put-ActiveDimStyle **DOC** (vla-item DimS CurDim))
      )
    )
  )

月下闲人

自贡黄明儒 发表于 2024-1-9 07:08
(defun do2 (DimS)
    (if        (setq e (entsel "\n 拾取标注，设置为当前标注样式:"))
      (progn

收到，非常感谢