Логотип сайта поддержки пользователей САПРО сайте поддержки пользователей САПР Translate to:

Экспорт пути к проекту в файл

Назад к списку функций
;;; ProjectPaths.LSP
;;; Сохраняет пути к файлу, которые затем можно импортировать на другой компьютер
;;; Проверено на AutoCAD 2000, 2006

(vl-load-com)

(defun ReadProject-Settings (cprof)
  (vl-registry-descendents
    (strcat
      "HKEY_CURRENT_USER\\"
      (vlax-product-key)
      "\\Profiles\\"
      cprof
      "\\Project Settings"
    )
  )
)

(defun ReadRefSearchPath (cprof ProjSet)
  (vl-registry-read
    (strcat
      "HKEY_CURRENT_USER\\"
      (vlax-product-key)
      "\\Profiles\\"
      cprof
      "\\Project Settings\\"
      ProjSet
    )
    "RefSearchPath"
  )
)

;;; Пример: (AllProjPath (getvar "CPROFILE"))
(defun AllProjPath (cprof / lst ProjSet)
  (foreach ProjSet (ReadProject-Settings cprof)
    (setq lst (cons (cons ProjSet (ReadRefSearchPath cprof ProjSet)) lst))
  )
)

;;; Пример: (WriteRefSearchPath (getvar "CPROFILE") "Project1" "c:\temp;c:\project")
(defun WriteRefSearchPath (cprof ProjSet path)
  (vl-registry-write
    (strcat
      "HKEY_CURRENT_USER\\"
      (vlax-product-key)
      "\\Profiles\\"
      cprof
      "\\Project Settings\\"
      ProjSet
    )
    "RefSearchPath"
    path
  )
)

;;; Удаляет все пути к профилям
(defun DeleteRefSearchPath (cprof)
  (foreach ProjSet (ReadProject-Settings cprof)
    (vl-registry-delete
      (strcat
        "HKEY_CURRENT_USER\\"
        (vlax-product-key)
        "\\Profiles\\"
        cprof
        "\\Project Settings\\"
        ProjSet
      )
    )
  )
)

;;; Пример: (WriteAllProjPath (getvar "CPROFILE") (list (cons "Project1" "C:\\") (cons "Project2" "D:\\")))
;;; Сначала удаляет все старые пути
(defun WriteAllProjPath (cprof lst / ProjSet)
  (DeleteRefSearchPath cprof)
  (foreach ProjSet lst
    (WriteRefSearchPath cprof (car ProjSet) (cdr ProjSet))
  )
)

;;; Пример: (Print-AllProjPaths (getvar "CPROFILE"))
(defun Print-AllProjPaths (cprof / ProjSet)
  (princ "Project Files Search Path:\n")
  (foreach ProjSet (ReadProject-Settings cprof)
    (princ ProjSet)
    (princ " = ")
    (princ (ReadRefSearchPath cprof ProjSet))
    (terpri)
  )
  (princ)
)

;;; Изменить "r:\\paths.txt" на местоположение на сервере
;;; (getProjectPaths "r:\\paths.txt")
(defun getProjectPaths (fn / cprof paths f)
  (setq cprof (getvar "CPROFILE"))
  (setq paths (AllProjPath cprof))
  (setq f (open fn "w"))
  (foreach ProjSet (ReadProject-Settings cprof)
    (write-line ProjSet f)
    (write-line (ReadRefSearchPath cprof ProjSet) f)
  )  
  (close f)
)

;;; Изменить "r:\\paths.txt" на местоположение на сервере
;;; (putProjectPaths "r:\\paths.txt")
(defun putProjectPaths (fn / cprof  line1 line2 paths f)
  (setq cprof (getvar "CPROFILE"))
  (setq f (open fn "r"))
  (while (and (setq line1 (read-line f)) (setq line2 (read-line f)))
    (setq paths (cons (cons line1 line2) paths))
  )
  (close f)
  (WriteAllProjPath cprof paths)
)



Copyright © Сайт поддержки пользователей САПР by Victor Tkachenko