NANOCAD ШОУ
dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP.Экспорт описания типа линии из dwg файла в lin

LISP.Экспорт описания типа линии из dwg файла в lin

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 22.10.2007, 13:59 1 |
LISP.Экспорт описания типа линии из dwg файла в lin
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,554
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™

VVA вне форума Вставить имя

Собственно это и делает: экспортирует описание типа линии из dwg файла в lin файл. (для чего нужно)
Код:
[Выделить все]
;;Опубликовано Keith
;; http://www.theswamp.org/index.php?topic=506.0
;;упоминалась http://dwg.ru/f/showthread.php?t=14319
;------------------------------------------------------------
;  Команда: LTEXTRACT
;  Эта команда позволяет экспортировать описание
;  типов линий из чертежей (*.dwg) в файл описания типов линий (*.lin)
;  Код можно сохранить в файле ltextract.lsp
;  Возможный макрос для кнопки или пункта меню:
;  ^C^C(if (not C:LTEXTRACT)(load "LTEXTRACT"));LTEXTRACT
;------------------------------------------------------------
 
;;;   ----------- LTExtract - Version 1.2 -----------
;;;   Copyright (C) 2002-2008  by ResourceCAD International
;;;   Author:   K.E. Blackie
;;;   
;;;   
;;;   BCI COMPUTER SOLUTIONS PROVIDES THIS PROGRAM "AS IS" AND WITH
;;;   ALL FAULTS. RESOURCECAD INTERNATIONAL SPECIFICALLY DISCLAIMS ANY
;;;   IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR
;;;   USE.  RESOURCECAD INTERNATIONAL DOES NOT WARRANT THAT THE OPERATION
;;;   OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.
;;;   
;;;   
;;;   ResouceCAD International
;;;   http://www.resourcecad.com
;;;   
;;;   DESCRIPTION
;;;   LTExtract will extract all of the linetypes defined in a drawing to a seperate
;;;   linetype definition file, including complex linetypes using text and shape
;;;   modifiers.
;;;
;;;   August 17, 2002
;;;   April 23, 2008
;;;   Feb    19, 2016
;;;   ------------------------------------------------------------


(defun c:ltextract ()
  (setq ltlist (tblnext "LTYPE" t))
  (if ltlist
    (setq ltlist (entget (tblobjname "LTYPE" (cdr (assoc 2 ltlist)))))
  )
  (setq ltfile (getvar "dwgname"))
  (if (= (strcase (substr ltfile (- (strlen ltfile) 3) 4))
	 (strcase ".dwg")
      )
    (setq
      ltfile (strcat (substr ltfile 1 (- (strlen ltfile) 4)) ".lin")
    )
    (setq ltfile (strcat ltfile ".lin"))
  )
  (setq ltfile (getfiled "Save Linetype Definition As" ltfile "lin" 9))
  (if ltfile
    (progn
      (setq fn (open ltfile "w"))
      (while ltlist
	(setq ltname (strcat "*" (strcase (cdr (assoc 2 ltlist))))
	      ltdesc (cdr (assoc 3 ltlist))
	)
	(setq ltdef "A"
	      wval nil
	)
	(setq ltlist (member (assoc 49 ltlist) ltlist))
	(while (assoc 49 ltlist)
	  (setq wval (get74 ltlist))
	  (setq def (cdr (assoc 49 ltlist)))
	  (setq def (strcat "," (rtos def 2 8)))
	  (if wval
	    (setq ltdef (strcat ltdef wval def))
	    (setq ltdef (strcat ltdef def))
	  )
	  (if (> (length ltlist) 1)
	    (setq ltlist (cdr (member (assoc 49 ltlist) ltlist)))
	    (setq ltlist (list nil))
	  )
	)
	(setq ltlist (tblnext "LTYPE"))
	(if ltlist
	  (progn
	    (setq ltlist
		   (entget (tblobjname "LTYPE" (cdr (assoc 2 ltlist)))
		   )
	    )
	  )
	)
	(if (/= ltdef "A")
	  (progn
	    (write-line (strcat ltname "," ltdesc) fn)
	    (write-line ltdef fn)
	  )
	)
      )
      (close fn)
    )
  )
  (princ)
)

(defun get74 (wlist / rval)
  (setq ass74 (cdr (assoc 74 wlist)))
  (cond
    ((= ass74 0) (return nil nil nil nil))
    ((= ass74 1)
     (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist)))))
	     nil
	     "a"
	     nil
     )
    )
    ((= ass74 2)
     (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist)))))
	     (cdr (assoc 9 wlist))
	     "r"
	     nil
     )
    )
    ((= ass74 3)
     (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist)))))
	     (cdr (assoc 9 wlist))
	     "a"
	     nil
     )
    )
    ((= ass74 4)
     (return (cdr (assoc 3 (entget (cdr (assoc 340 wlist)))))
	     nil
	     "r"
	     (cdr (assoc 75 wlist))
     )
    )
    ((= ass74 5)
     (return (cdr (assoc 3 (entget (cdr (assoc 340 wlist)))))
	     nil
	     "a"
	     (cdr (assoc 75 wlist))
     )
    )
    (T (return nil nil nil nil))
  )
  rval
)

(defun return (shx text rot shp / ttext)
  (setq test (cdr (assoc 50 wlist)))
  (if (and test rot)
    (setq rot (strcat rot "=" (angtos test)))
  )
  (setq test (cdr (assoc 46 wlist)))
  (if (and test rot)
    (setq rot (strcat rot ",S=" (rtos test 2 8)))
  )
  (setq test (cdr (assoc 44 wlist)))
  (if (and test rot)
    (setq rot (strcat rot ",X=" (rtos test 2 8)))
  )
  (setq test (cdr (assoc 45 wlist)))
  (if (and test rot)
    (setq rot (strcat rot ",Y=" (rtos test 2 8)))
  )
  (if text
    (setq ttext (strcat ",[\"" text "\"," shx "," rot "]"))
  )
  (if (and (not text) shp)
    (setq ttext (strcat ",[" (getname shp shx) "," shx "," rot "]"))
  )
  (setq rval ttext)
)

(defun getname (shape shapefile / tmp)
  (setq ss1 shape ss2 shapefile)
  (if (and
        (or (setq tmp (findfile shapefile))
          (setq tmp (findfile (strcat shapefile ".shx")))
          )
        (setq shapefile (findfile tmp))
        )
  (if (setq sfn (open shapefile "r"))
    (progn
      (repeat 23
	(read-char sfn)
      )
      (setq lownum (read-char sfn))
      (read-char sfn)
      (setq charcount (- shape lownum))
      (setq hignum (read-char sfn))
      (read-char sfn)
      (setq shpcount (read-char sfn))
      (read-char sfn)
      (repeat (* shpcount 4)
	(read-char sfn)
      )
      (setq zerocount 0)
      (while (< zerocount (* charcount 2))
	(setq this (read-char sfn))
	(if (= this 0)
	  (setq zerocount (1+ zerocount))
	)
      )
      (setq char1 (read-char sfn))
      (setq name "")
      (while (/= 0 char1)
	(setq name (strcat name (chr char1)))
	(setq char1 (read-char sfn))
      )
      (close sfn)
      name
    )
    "\"ERROR\""
  )
    "\"ERROR\""
    )
)
(princ "\nType LTEXTRACT in command line (ver 1.2)")(princ)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 19.02.2016 в 17:06. Причина: Обновлено до версии 1.2
Просмотров: 21397
 
Автор темы   Непрочитано 28.09.2017, 16:15
#21
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,554
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


mindchamber, А какая проблема найти в текстовом файле поиском нужное описание по имени и скопировать в новый файл?
Или удалить все кроме нужного
?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 02.10.2017, 21:35
#22
mindchamber


 
Регистрация: 29.07.2017
Сообщений: 23


Цитата:
Сообщение от VVA Посмотреть сообщение
mindchamber, А какая проблема найти в текстовом файле поиском нужное описание по имени и скопировать в новый файл?
Или удалить все кроме нужного
?
Бесспорно тут вы правы. Но когда файл обходит пару тройку аутсорс инженеров, то файл довольно сильно "распухает", что делает затруднительным поиск соответствующего типа линии. Как бы то ни было ни у кого такой проблемы не возникло, так что не утруждайте себя ответом на мое сообщение. Благодарю.
mindchamber вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 03.10.2017, 13:58
#23
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,554
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от mindchamber Посмотреть сообщение
файл довольно сильно "распухает",
Есть очень большое подозрение, что дело в "словарях DGN"
Читать 1-й пост Помогите уменьшить размер файла DWG и FАQ Как уменьшить объем файла dwg
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP.Экспорт описания типа линии из dwg файла в lin

 VetCAD++
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
lisp : проверка наличия типа линии в файле Кулик Алексей aka kpblc LISP 4 21.06.2005 08:04
ГОСТ на ванты и оттяжки ??? зщцук? Поиск литературы, чертежей, моделей и прочих материалов 1 17.05.2005 06:53
Загрузка типа линии из макроса Кулик Алексей aka kpblc Программирование 4 24.01.2005 14:57
Размер файла dwg alex-alex Прочее. Архитектура и строительство 5 10.09.2004 00:28

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||