| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

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

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

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

Собственно это и делает: экспортирует описание типа линии из 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
Просмотров: 33601
 
Автор темы   Непрочитано 28.09.2017, 16:15
#21
VVA

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


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


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


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для 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
Просмотров: 16
Размер:	70.3 Кб
ID:	211460
maiklbua вне форума  
 
Непрочитано 28.02.2019, 15:10
#25
kacugu

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


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

программист, рыцарь ObjectARX
 
Регистрация: 09.05.2005
Киев
Сообщений: 2,274
Отправить сообщение для Александр Ривилис с помощью 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,800
<phrase 1= Отправить сообщение для 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
Просмотров: 16
Размер:	168.8 Кб
ID:	211697

Типы Линий.dwg
maiklbua вне форума  
 
Автор темы   Непрочитано 10.03.2019, 13:32
#30
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для 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