请教CAD，op选项里面，输入配置arg?

sbwdx

我D盘有自己的ARG文件，op选项里面的输入配置，能用LSP调用吗？给个指定（文件）路径，就添加自己的arg文件到，配置列表？

nyistjz

你研究一下下面的代码，应该能解决你的问题。

●25配置文件
●25.1 [功能] 配置文件集合
(defun MJ:Profiles ()
  (vla-get-Profiles (MJ:AcadPrefs))
)
●25.2 [功能] 设置配置文件
● 示例:   (MJ:SetProfile "MJ:Profile")
(defun MJ:SetProfile (pname)
  (vl-load-com)
  (vla-put-ActiveProfile
    (vla-get-Profiles
      (vla-get-Preferences
        *ACAD*
      )
    )
    pname
  )
)
●25.3 [功能] 重新装载配置文件
● 示例: (MJ:ProfileReLoad "profile1" "c:\\profiles\\profile1.arg")
(defun MJ:ProfileReLoad        (name ARGname)
  (cond
    ((= (vlax-get-property (MJ:Profiles) 'ActiveProfile) name)
     ● or following code.
     ●(= (vla-get-ActiveProfile (MJ:Profiles)) name)
     (princ "\nCannot delete a profile that is in use.")
    )
    ((and
       (MJ:ProfileExists-p name)
       (findfile ARGname)
     )
     (MJ:ProfileDelete name)
     (MJ:ProfileImport name ARGname)
     (vla-put-ActiveProfile (MJ:Profiles) name)
    )
    ((and
       (not (MJ:ProfileExists-p name))
       (findfile ARGname)
     )
     (MJ:ProfileImport name ARGname)
     (vla-put-ActiveProfile (MJ:Profiles) name)
    )
    ((not (findfile ARGname))
     (princ (strcat "\nCannot locate ARG source: " ARGname))
    )
  )
)
●25.4 [功能] 重启默认配置文件
● 示例: (MJ:ProfileReset "profile1")
(defun MJ:ProfileReset (strName)
  (if (MJ:ProfileExists-p strName)
    (vlax-Invoke-Method
      (MJ:Profiles)
      'ResetProfile
      strName
    )
    (princ (strcat "\nProfile [" strName "] does not exist."))
  )
)
●25.5 [功能] 输出配置文件
● ARGS: arg-file(string), profile-name(string), T(Boolean)
● 示例: (MJ:ProfileExport "<<Unnamed Profile>>" "D:/test.arg" T)
(defun MJ:ProfileExport (strName strFilename BooleReplace)
  (if (MJ:ProfileExists-p strName)
    (if        (not (findfile strFilename))
      (progn
        (vlax-Invoke-Method
          (vlax-Get-Property (MJ:AcadPrefs) "rofiles")
          'ExportProfile
          strName
          strFilename
        )
        T
      )
      (if BooleReplace
        (progn
          (vl-file-delete (findfile strFilename))
          (if (not (findfile strFilename))
            (progn
              (vlax-Invoke-Method
                (vlax-Get-Property (MJ:AcadPrefs) "rofiles")
                'ExportProfile
                strName
                strFilename
              )
              T             
            )                       
            (princ "\nCannot replace ARG file, aborted.")
          )                       
        )                       
        (princ (strcat "\n" strFilename " already exists, aborted.")
        )
      )                               
    )                               
  )                               
)
●25.6 [功能] 输出配置文件
● NOTES: Export an existing profile to a new external .ARG file
● 示例: (MJ:ProfileExportX "<<Unnamed Profile>>" "D:/test1.arg")
(defun MJ:ProfileExportX (pName ARGfile)
  (cond
    ((MJ:ProfileExists-p pName)
     (vlax-invoke-method
       (MJ:Profiles)
       'ExportProfile
       pName
       ARGfile
       (vlax-make-variant 1 :vlax-vbBoolean)
       ● == TRUE
     )
    )
    (T (princ "\nNo such profile exists to export."))
  )
)
●25.7 [功能] 输入配置文件
● ARGS: profile-name(string), arg-file(string)
● 示例: (MJ:ProfileImport "MJ:Profile" "c:/test.arg")
● VBA equivalent:                                                              ●
●         ThisDrawing.Application.preferences._                                      ●
●     Profiles.ImportProfile _                                                        ●
●       strProfileToImport, strARGFileSource, True                              ●
(defun MJ:ProfileImport (pName ARGfile)
  (cond
    ((findfile ARGfile)
     (vlax-invoke-method
       (vlax-get-property (MJ:AcadPrefs) "rofiles")
       'ImportProfile
       pName
       ARGfile
       (vlax-make-variant 1 :vlax-vbBoolean)
       ● == TRUE
     )
    )                                        ;
    (T (princ "\nARG file not found to import!"))
  )                               
)
●25.8 [功能] 复制配置文件
● 示例: (MJ:ProfileCopy pName newName)
(defun MJ:ProfileCopy        (Name1 Name2)
  (cond
    ((and
       (MJ:ProfileExists-p Name1)
       (not (MJ:ProfileExists-p Name2))
     )
     (vlax-invoke-method
       (MJ:Profiles)
       'CopyProfile
       Name1
       Name2
     )
    )                                        ;
    ((not (MJ:ProfileExists-p Name1))
     (princ "\nError: No such profile exists.")
    )                                        ;
    ((MJ:ProfileExists-p Name2)
     (princ "\nProfile already exists, copy failed.")
    )
  )
)
●25.9 [功能] 重命名配置文件
● 示例: (MJ:ProfileRename oldName newName)
(defun MJ:ProfileRename (oldName newName)
  (cond
    ((and
       (MJ:ProfileExists-p oldName)
       (not (MJ:ProfileExists-p newName))
     )
     (vlax-invoke-method
       (MJ:Profiles)
       'RenameProfile
       oldName
       newName
     )
    )               
    (T (princ))
    ● add your error handling here?
  )
)
●25.10 [功能] 删除配置文件
● 示例: (MJ:ProfileDelete "MJ:Profile")
(defun MJ:ProfileDelete (pName)
  (vlax-invoke-method
    (vlax-get-property (MJ:AcadPrefs) "rofiles")
    'DeleteProfile
    pName
  )
)
●25.11 [功能] 配置文件是否存在
● 示例: (if (MJ:ProfileExists-p "<<Unnamed Profile>>") ...)
(defun MJ:ProfileExists-p (pName)
  (member (strcase pName) (mapcar 'strcase (MJ:ProfileList)))
)
●25.12 [功能] 配置文件列表
●返回示例("<<Unnamed Profile>>" "yky_m2006")
(defun MJ:ProfileList        (/ hold)
  (vlax-invoke-method
    (vlax-get-property (MJ:AcadPrefs) "rofiles")
    'GetAllProfileNames
    'hold
  )
  (if hold
    (vlax-safearray->list hold)
  )
)

669423907

(defun c:2008()
(vla-put-activeprofile (vla-get-profiles(vla-get-preferences (vlax-get-acad-object))) "CAD2008")
(princ))

sbwdx

669423907 发表于 2020-1-15 17:04
(defun c:2008()
(vla-put-activeprofile (vla-get-profiles(vla-get-preferences (vlax-get-acad-object) ...

这个我，在网站上，查到了的，能切换打开选项的配置，但是其他路径的arg文件不行

1993063

做个记号

sbwdx

nyistjz 发表于 2020-1-19 23:43
你研究一下下面的代码，应该能解决你的问题。

●25配置文件

阁下，这个是VBA语言吧，哎，觉得有可能弄得出来，就是有点难哦，要是有懂VBA得就好办了。

开心无惧

nyistjz 发表于 2020-1-19 23:43
你研究一下下面的代码，应该能解决你的问题。

●25配置文件

请问下
为啥我指定的配置会变化  
有时双击桌面CAD图标 新打开CAD后显示一个未命名配置，整个界面都改了；