取得对象的图层，文字样式，标注样式置位当前。

liuhe

CAD其实自带一个把对象的图层置位当前当前图层，但是个人觉得功能不够用。
于是就写了一个 对实体进行分析，
如果是text、mtext，就把实体的文字样式和文字高度设置为激活状态。
同理MULTILEADER（多重引线）、DIMENSION（标注样式）、AcDbTable（表格）。
没啥技术含量。特意用dxf码和对象属性混写的，有兴趣的可以写成纯lisp或者vlisp。


(prompt "\n快捷键SETVARLAYDIMDLI")
(DEFUN C:SETVARLAYDIMDLI (/ E);;;;;把当前的标注样式，文字样式，图层作为当前设置SETVARLAYDIMDLI
  (IF (SETQ E (CAR (ENTSEL)))
    (progn
      (COND
        ((= "TEXT" (CDR (ASSOC 0 (ENTGET E))))
         (if (/= (getvar 'textstyle)
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
             )
           (SETVAR 'textstyle
                   (VLA-GET-StyleName (vlax-ename->vla-object E))
           )
         )
         (if (/= (getvar 'textsize)
                 (CDR (ASSOC 40 (ENTGET E)))
             )
           (SETVAR 'textsize
                   (CDR (ASSOC 40 (ENTGET E)))
           )
         )         
        )
        ((= "MTEXT" (CDR (ASSOC 0 (ENTGET E))))
         (if (/= (getvar 'textstyle)
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
             )
           (SETVAR 'textstyle
                   (VLA-GET-StyleName (vlax-ename->vla-object E))
           )
         )
         (if (/= (getvar 'textsize)
                 (CDR (ASSOC 40 (ENTGET E)))
             )
           (SETVAR 'textsize
                   (CDR (ASSOC 40 (ENTGET E)))
           )
         )         
        )
        ((= "MULTILEADER" (CDR (ASSOC 0 (ENTGET E))))
         (if (/= (getvar 'CMLEADERSTYLE)
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
             )
           (SETVAR 'CMLEADERSTYLE
                   (VLA-GET-StyleName (vlax-ename->vla-object E))
           )
         )
         (if (/= (VLA-GET-Name
                   (vla-get-ActiveTextStyle
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                   )
                 )
                 (VLA-GET-TextStylename (vlax-ename->vla-object E))
             )
           (setvar 'textstyle
                   (VLA-GET-TextStylename (vlax-ename->vla-object E))
           )
         )
        )
        ((= "DIMENSION" (CDR (ASSOC 0 (ENTGET E))))
         (if (/= (VLA-GET-Name
                   (vla-get-ActiveDimStyle
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                   )
                 )
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
             )
           (vla-put-ActiveDimStyle
             (vla-get-ActiveDocument (vlax-get-acad-object))
             (vlax-ename->vla-object
               (tblobjname
                 "dimstyle"
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
               )
             )
           )
         )
         (if (/= (VLA-GET-Name
                   (vla-get-ActiveTextStyle
                     (vla-get-ActiveDocument (vlax-get-acad-object))
                   )
                 )
                 (VLA-GET-TextStyle (vlax-ename->vla-object E))
             )
           (setvar 'textstyle
                   (VLA-GET-TextStyle (vlax-ename->vla-object E))
           )
         )
        )
        ((= "AcDbTable"
            (VLA-GET-ObjectName (vlax-ename->vla-object E))
         )
         (if (/= (getvar 'CTableSTYLE)
                 (VLA-GET-StyleName (vlax-ename->vla-object E))
             )
           (SETVAR 'CTableSTYLE
                   (VLA-GET-StyleName (vlax-ename->vla-object E))
           )
         )
         (if
           (/= (VLA-GET-Name
                 (vla-get-ActiveTextStyle
                   (vla-get-ActiveDocument (vlax-get-acad-object))
                 )
               )
               (vla-getTextStyle (vlax-ename->vla-object E) acDataRow)
           )
            (setvar
              'textstyle
              (vla-getTextStyle (vlax-ename->vla-object E) acDataRow)
            )
         )
        )

      )
      (if (/= (GETVAR 'clayer) (CdR (ASSOC 8 (ENTGET E))))
        (SETVAR 'clayer (CdR (ASSOC 8 (ENTGET E))))
      )
    )
  )
  (princ)
)

xyp1964

太多的if基本多余

paulpipi

感谢分享！！！！！

liuhe

xyp1964 发表于 2022-11-14 20:15
太多的if基本多余

vla函数有一个问题，如果当前设置跟对象设置一样，会出现未知出错。为了避免报错，才进行先判断再激活

行天下

进来看看，学习前辈的经验

guankuiwu

不错的想法。可以加个面板最方便了，勾选相应的内容。要不没提示不太明白。

pxt2001

楼主代码和思路很不错，这个功能的确很有必要，但要加上以下红色代码，否则如截图所示，不能立即更新。
我的CAD版本：64位 CAD2017，不知道是不是CAD自身的原因导致。
(DEFUN C:SETVARLAYDIMDLI (/ E);;;;;把当前的标注样式，文字样式，图层作为当前设置SETVARLAYDIMDLI
  (IF (SETQ E (CAR (ENTSEL)))
    (progn
      ……
     (arxload "acopm.arx")
     (command "PSELECT" e "") ;亮显对象
     (command "SELECT" "p" "");取消亮显
    )
  )
  (princ)
)

hubeiwdlue

谢谢流河大神的分享，好好学习下。

shirker

谢谢老师们分享