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

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

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

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

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

Собственно это и делает: экспортирует описание типа линии из dwg файла в lin файл. (для чего нужно)
Код:
[Выделить все]
;;; Опубликовано Keith
;;; http://www.theswamp.org/index.php?topic=506.0
;;; http://forum.dwg.ru/showthread.php?p=1787047
;;; ver 1.4  http://forum.dwg.ru/showpost.php?p=1787057&postcount=26
;;------------------------------------------------------------
;;  Команда: LTEXTRACT
;;  Эта команда позволяет экспортировать описание
;;  типов линий из чертежей (*.dwg) в файл описания типов линий (*.lin)
;;  Код можно сохранить в файле ltextract.lsp
;;  Возможный макрос для кнопки или пункта меню:
;;  ^C^C(if (not C:LTEXTRACT)(load "LTEXTRACT"));LTEXTRACT
;;------------------------------------------------------------
 
;;;   ----------- LTExtract - Version 1.4 -----------
;;;   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 ( / dmz ltlist ltfile fn ltname ltdesc ltdef wval def)
  (setq dmz (getvar "DIMZIN"));_VVA 2019-03-05 ver 1.3
  (setvar "DIMZIN" 8);_VVA 2019-03-05 ver 1.3
  (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
            (if (/= ltdef "A")                     ;_VVA 2019-03-10 ver 1.4
              (setq ltdef (strcat ltdef wval def)) ;_VVA 2019-03-10 ver 1.4
              (setq ltdef (strcat ltdef def wval)) ;_VVA 2019-03-10 ver 1.4
              )                                    ;_VVA 2019-03-10 ver 1.4
	    (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)
    )
  )
  (setvar "DIMZIN" dmz);_VVA 2019-03-05 ver 1.3
  (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 0 3))) ;_VVA 2019-03-05 ver 1.3
  )
  (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.4)")(princ)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 10.03.2019 в 13:29. Причина: Обновлено до версии 1.4 см #27
Просмотров: 30327
 
Автор темы   Непрочитано 28.09.2017, 16:15
#21
VVA

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


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


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


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

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


Цитата:
Сообщение от mindchamber Посмотреть сообщение
файл довольно сильно "распухает",
Есть очень большое подозрение, что дело в "словарях DGN"
Читать 1-й пост Помогите уменьшить размер файла DWG и FАQ Как уменьшить объем файла dwg
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.02.2019, 15:01
#24
maiklbua


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


Доброго всем дня.
Не могу сам разрешить проблему.
С помощью лиспа LTEXTRACT(экспорт линий в Lin) создаю файл с типами линий.

описание из файла .Lin
*ЖЕЛЗНЫЕ ДОРОГИ(ОСЕВАЯ),Желзные дороги(осевая)
A,0.00000000,-12.00000000,[TRACK1,ltypeshp.shx,r=0d0'0",S=2.00000000,X=0.00000000,Y=0.00000000],0.00000000
*ЖЕЛЗНЫЕ ДОРОГИ УЗКОКОЛЕЙНЫЕ (ОСЕВАЯ),Желзные дороги узкоколейные (осевая)
A,0.00000000,-6.00000000,[TRACK1,ltypeshp.shx,r=0d0'0",S=1.50000000,X=0.00000000,Y=0.00000000],-6.00000000,[TRACK1,ltypeshp.shx,r=0d0'0",S=1.00000000,X=0.00000000,Y=0.00000000],0.00000000
*ТРАМВАЙНЫЕ ЛИНИИ,Трамвайные линии
A,0.00000000,-6.00000000,[TRACK1,ltypeshp.shx,r=0d0'0",S=2.00000000,X=0.00000000,Y=0.00000000],-6.00000000,[TRACK1,ltypeshp.shx,r=0d0'0",S=1.50000000,X=0.00000000,Y=0.00000000],0.00000000


Далее пытаюсь его загрузить в чистый чертеж и получаю ниже следующий ответ.
---------------------------
AutoCAD
---------------------------

Некорректное определение типа линий ЖЕЛЗНЫЕ ДОРОГИ(ОСЕВАЯ) в строке 2 файла C:\Users\fox\Desktop\Почта\Чертеж3.lin:
В выражении должны присутствовать R, A, U, S, X или Y
---------------------------
ОК
---------------------------

Нажмите на изображение для увеличения
Название: Screenshot_3.jpg
Просмотров: 10
Размер:	70.3 Кб
ID:	211460
maiklbua вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.02.2019, 15:10
#25
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 652


Замените везде 0d0'0'' на 0
kacugu на форуме вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.02.2019, 15:20
#26
Александр Ривилис

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,230
Отправить сообщение для Александр Ривилис с помощью Skype™


VVA,
Документация подсказывает, что углы должны быть в градусах (по умолчанию - иначе нужен суффикс d, r или g). Соответственно вместо
Код:
должно быть
Код:
[Выделить все]
 (angtos test 0) ;; Возможно следует сразу задать сразу и точность: (angtos test 0 3)
Кроме того в силу ограничения длины строки в 80 символов настоятельно рекомендуется установить DIMZIN в 8 (или 12) для отбрасывания замыкающих (и ведущих) нулей.

Последний раз редактировалось Александр Ривилис, 28.02.2019 в 15:33.
Александр Ривилис вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 04.03.2019, 15:28
#27
maiklbua


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


огромное спасибо.
с кодами к Лиспам мне пока еще рано. Я в них ни чего не понимаю.

Последний раз редактировалось maiklbua, 04.03.2019 в 15:46.
maiklbua вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 05.03.2019, 09:30
#28
VVA

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


Обновил #1 до версии 1.3
maiklbua, можешь попробовть
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 07.03.2019, 14:21
#29
maiklbua


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


Доброго дня Лисп попробовал обновленный 1.3. файл Lin создался без 0d0'0' и лишних нулей. но при загрузке в чистый чертеж автокад ругается и не все линии ест.
Нажмите на изображение для увеличения
Название: Screenshot_4.jpg
Просмотров: 12
Размер:	168.8 Кб
ID:	211697

Типы Линий.dwg
maiklbua вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 10.03.2019, 13:32
#30
VVA

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


Цитата:
Сообщение от maiklbua Посмотреть сообщение
но при загрузке в чистый чертеж автокад ругается и не все линии ест.
Обновил до версии 1.4
При загрузке в чистый чертеж по прежнему будет ругаться, т.к. в описании некоторых типов линий используется стиль Бм-431
Его предварительно нужно создать
Цитата:
*ВОДОПРОВОД НАЗЕМНЫЙ,Водопровод наземный
A,20,-2,["В",Бм-431,r=0,S=1,X=-1.9,Y=-0.875],20
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.03.2019, 09:24
#31
maiklbua


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


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

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

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
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 || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||