Здесь вы можете скачать документацию и программы для САПР AutoCAD, PCAD, 3DS, Inventor, Pro/E, Solidworks и других CAD CAM CAE EDA GIS

Различные функции для работы с профилями

(vl-load-com)

; импорт профиля в грубой форме
;
; (forceImport "profilename" "C:\\temp\\testprof.arg" 1)
; inclpathinfo=1 сохранить информацию о пути в файле реестра.
; inclpathinfo=0 не сохранять информацию о пути в файле реестра.
; возвращает T если профиль был импортирован
(defun forceImport (profilename argname inclpathinfo / tmp1 tmp2)
  (setq tmp1 "<>")
  (deleteProfile tmp1)
  (if (importProfile tmp1 argname inclpathinfo)
    (progn
      (putActiveProfile tmp1)
      (deleteProfile profilename)
      (renameProfile tmp1 profilename)
      (putActiveProfile profilename)
      T
    )
    nil
  )
)

(defun getActiveProfile ()
  (vla-get-activeprofile
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
  )
)

(defun putActiveProfile (profilename)
  (vla-put-activeprofile
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
    profilename
  )
)

(defun getAllProfileNames(/ allprofiles)
  (vla-getallprofilenames
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))) 
    'allprofiles
  )
  (vlax-safearray->list allprofiles)
)

(defun existProfile (profilename)
  (not (not (member
    (strcase profilename)
    (mapcar '(lambda (x) (strcase x)) (getallprofilenames))
  )))
)

(defun c:listProfileNames(/ nr profnames)
  (setq nr 0)
  (setq profnames (getAllProfileNames))
  (repeat (length profnames)
    (princ (nth nr profnames))
    (print)
    (setq nr (1+ nr))
  )
  (princ)
)

; возвращает T если профиль удаленЮ и nil, если нет
(defun deleteProfile (profilename)
  (if (and
        (/= (strcase profilename) (strcase (getActiveProfile)))
        (existProfile profilename))
    (not (vla-deleteprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
    ))
  )
)

; Удаляет все профиля кроме текущего
(defun deleteAllProfilesExceptCurrent (/ item)
  (foreach item	(getAllProfileNames)
    (vl-catch-all-apply
      'vla-deleteprofile
      (list (vla-get-profiles
	      (vla-get-preferences (vlax-get-acad-object))
	    )
	    item
      )
    )
  )
)

; возращает T если профиль сброшен, и nil - если нет
(defun resetProfile (profilename)
  (if (existProfile profilename)
    (not (vla-resetprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
    ))
  )
)

; возращает T если профиль переименован и nil если нет
; если profilenameNew существует, он заменятется на profilenameOld
(defun renameProfile (profilenameOld profilenameNew)
  (if (existProfile profilenameOld)
    (not (vla-renameprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilenameOld
      profilenameNew
    ))
  )
)

; возращает T если профиль скопирован и nil - если нет
; если profilename2 существует, он копируется
(defun copyProfile (profilename1 profilename2)
  (if (existProfile profilename1)
    (not (vla-copyprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename1
      profilename2
    ))
  )
)

; (exportProfile "profilename" "C:\\TEMP\\profilename.arg")
; если путь не указан, профиль сохраняется в текущий каталог
; если файл профиля с указанным именем существует, он перезаписываетеся
; возращает T если экспорт профиля прошел удачно
(defun exportProfile (profilename argname)
  (if (existProfile profilename)
    (not (vla-exportprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
      argname
    ))
  )
)

; (importProfile "profilename" "C:\\TEMP\\profilename.arg" 1)
; если профиль с указанным именем существует, он перезаписываетеся
; если путь не указан, профиль импортируется из текущего каталога
; inclpathinfo=1   сохранить информацию о пути в файле реестра.
; inclpathinfo=0   не сохранять информацию о пути в файле реестра.
; return T if profile is imported
(defun importProfile (profilename argname inclpathinfo)
  (not (vl-catch-all-apply 'vla-importprofile (list
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
    profilename
    argname
    inclpathinfo
  ))
  )
)

; импорт профиля в грубой форме и удаление всех остальных с уществующих профилей
; (forceImportAndDeleteTheRest "profilename" "C:\\temp\\testprof.arg" 1)
; inclpathinfo=1 сохранить информацию о пути в файле реестра.
; inclpathinfo=0 не сохранять информацию о пути в файле реестра.
; возвращает T если профиль был импортирован
(defun forceImportAndDeleteTheRest (profilename argname inclpathinfo / tmp1 tmp2)
  (setq tmp1 "<>")
  (deleteProfile tmp1)
  (if (importProfile tmp1 argname inclpathinfo)
    (progn
      (putActiveProfile tmp1)
      (deleteProfile profilename)
      (renameProfile tmp1 profilename)
      (putActiveProfile profilename)
      (deleteAllProfilesExceptCurrent)
      T
    )
    nil
  )
)