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

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

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

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

Собственно это и делает: экспортирует описание типа линии из 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
Просмотров: 56388
 
Автор темы   Непрочитано 06.11.2020, 23:07
1 | #41
VVA

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


mindchamber, Экспортируется
Цитата:
*БОРДЮР(R),Бордюр Право
A,0.75,[TRACK1,ltypeshp.shx,r=0,S=0.075,X=0,Y=-0.075],[TRACK1,ltypeshp.shx,r=0,S=0.075,X=0,Y=-0.075],0.1,[TRACK1,ltypeshp.shx,r=0,S=0.075,X=0,Y=-0.075],0.75
Учти, что масштаб типа линии для твоего отрезка равен 5.
Правильнее в описании типа линии откорректировать размеры, чтобы масштаб типа линии примитивов был равен 1
Типа такого
Цитата:
*БОРДЮР(R),Бордюр Право
A,0.75,[TRACK1,ltypeshp.shx,r=0,S=0.375,X=0,Y=-0.375],[TRACK1,ltypeshp.shx,r=0,S=0.375,X=0,Y=-0.375],0.5,[TRACK1,ltypeshp.shx,r=0,S=0.375,X=0,Y=-0.375],0.75
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 06.11.2020 в 23:12.
VVA вне форума  
 
Непрочитано 13.11.2020, 10:23
#42
mindchamber


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


Цитата:
Сообщение от VVA Посмотреть сообщение
mindchamber, Экспортируется
У меня пишет эту ошибку и экспортирует пустой файл. В чем может быть проблема?

Нашел другой lisp, вроде не выдает эту ошибку.
upd: нет, все равно не все типы линий экспортирует... autocad 2021
Миниатюры
Нажмите на изображение для увеличения
Название: Screenshot_1.png
Просмотров: 45
Размер:	10.9 Кб
ID:	231797  
Вложения
Тип файла: zip linout.zip (10.8 Кб, 37 просмотров)

Последний раз редактировалось mindchamber, 13.11.2020 в 10:46.
mindchamber вне форума  
 
Непрочитано 13.11.2020, 17:54
1 | #43
Barmaley Bubusikin


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


Сам пользуюсь LTEXTRACTом, но в этом чертеже корректнее сработал linout, - он убрал дубликат первой черты линии: [TRACK1,ltypeshp.shx,s=0.075,r=0,x=0,y=-0.075].
Barmaley Bubusikin вне форума  
 
Непрочитано 17.11.2020, 12:37
#44
DmAK


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


Присоединяюсь к mindchamber, большое спасибо VVA за полезные коды! Удивляюсь, когда поднимают вопрос применения данного лиспа. Так пишут те, кто никогда не передавал файлы заказчикам.
Но у меня возникают ошибки при загрузке выгруженного этим кодом файла. И я проанализировал то, что выгружает лисп на примере нескольких описаний линий.
Оригинальное описание линии:
*500_84_1, Откосы неукрепленные
A,1,[TOPOLINE,Topography.shx,S=1.2,R=90,X=0,Y=0],1,[TOPOLINE,Topography.shx,S=0.5,R=90,X=0,Y=0]
Выгруженное с помощью кода:
*500_84_1, Откосы неукрепленные
A,1,[TOPOLINE,Topography.shx,r=90,S=1.2,X=0,Y=0],[TOPOLINE,Topography.shx,r=90,S=1.2,X=0,Y=0],1

Как видите единичка улетает в конец описания. И-за этого не корректно отображается вид линии.
Далее...

Оригинальное описание линии:
*500_145_1, Участки с изрытой поверхностью
A,0.9,[TOPOZUBFILL,Topography.shx,S=-0.8,R=0],0
Выгруженное с помощью кода:
*500_145_1, Участки с изрытой поверхностью
A,0.9,[,Topography.shx,r=0,S=-0.8,X=0,Y=0],[,Topography.shx,r=0,S=-0.8,X=0,Y=0],0

Оригинальное описание линии:
*500_104, Сооружения морских нефтепромыслов разрушенные и полуразрушенные
A,0,[TOPOCIRCLEFILL,Topography.shx,S=1,R=0,X=0,Y=0],-1
Выгруженное с помощью кода:
*500_104, Сооружения морских нефтепромыслов разрушенные
A,0,[,Topography.shx,r=0,S=1,X=0,Y=0],[,Topography.shx,r=0,S=1,X=0,Y=0],-1
В следствие этого возникают ошибки.

Надеюсь это не из-за того что у меня кривой автокад. Хотя я допускаю это.

Последний раз редактировалось DmAK, 17.11.2020 в 16:29.
DmAK вне форума  
 
Непрочитано 18.03.2021, 10:01
#45
mindchamber


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


Экспортируйте кто-нибудь пожалуйста этот тип линий. Хочу сделать стрелку двухстороннюю но без промежуточной линии. Во вложениях dwg.
Вложения
Тип файла: dwg
DWG 2013
Чертеж1.dwg (36.3 Кб, 11 просмотров)
mindchamber вне форума  
 
Непрочитано 18.03.2021, 11:32
1 | #46
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,347


Код:
[Выделить все]
*119_3,"Электрокабель подземный низкого напряжения ---
A,2.0,-1.0,
[TRACK1,ltypeshp.shx,s=0.2,r=45,x=0.14142,y=-0.14142],
0.0,
[TRACK1,ltypeshp.shx,s=0.2,r=135,x=0.14142,y=0.14142],
4.0,
[TRACK1,ltypeshp.shx,s=0.2,r=135,x=-0.14142,y=-0.14142],
0.0,
[TRACK1,ltypeshp.shx,s=0.2,r=45,x=-0.14142,y=0.14142],
-1.0,2.0,0
koMon вне форума  
 
Непрочитано 22.03.2021, 12:16
#47
mindchamber


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Код:
[Выделить все]
*119_3,"Электрокабель подземный низкого напряжения ---
A,2.0,-1.0,
[TRACK1,ltypeshp.shx,s=0.2,r=45,x=0.14142,y=-0.14142],
0.0,
[TRACK1,ltypeshp.shx,s=0.2,r=135,x=0.14142,y=0.14142],
4.0,
[TRACK1,ltypeshp.shx,s=0.2,r=135,x=-0.14142,y=-0.14142],
0.0,
[TRACK1,ltypeshp.shx,s=0.2,r=45,x=-0.14142,y=0.14142],
-1.0,2.0,0
Спасибо. Как вы это сделали?
mindchamber вне форума  
 
Непрочитано 22.03.2021, 14:05
#48
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,347


пишу очередной экстрактор
koMon вне форума  
 
Непрочитано 05.04.2021, 09:57
#49
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,347


Цитата:
Сообщение от Nazarova Посмотреть сообщение
Помогите пожалуйста выяснить как правильно исправить описание, чтобы линии загрузились.
не копаясь глубоко.

Код:
[Выделить все]
*ACAD_ISO03W100,ISO штриховая (дл. промежутки) __    __    __
A,12,-18
*ACAD_ISO07W100,ISO dot . . . . . . . . . . . . . . . . . . . .
A,0,-0.3
*ACAD_ISO10W100,ISO ш/пункт. __ . __ . __ . __ . __ . __ . __ .
A,12,-3,0,-3
*ACAD_ISO12W100,ISO ш/пункт. (2 точки) __ . . __ . . __ . . __
A,12,-3,0,-3,0,-3
*DASHEDX2,Dashed (2x) ____  ____  ____  ____  ____  ___
A,1,-0.5
*DOT,Dot . . . . . . . . . . . . . . . . . . . . . .
A,0,-0.25
*FENCELINE1,Fenceline circle ----0-----0----0-----0----0---
A,15,-2,[CIRC1,ltypeshp.shx,s=1.5,x=-2],-1,15
*GPodsc,GPodsc
A,10,-3,[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=0.5],-2,
[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=1],-2,[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=0.5],-3
*HIDDENX2,Hidden (2x) ____ ____ ____ ____ ____ ____ ____
A,0.5,-0.25
*POVER,\/\/\/\/\/\/\/\
A,2.5,[P,Sam_shp.SHX,s=0.15],4.5,[P1,Sam_shp.SHX,s=0.15],4.5,
[P2,Sam_shp.SHX,s=0.15],1
*TG,TG
A,15,-3,[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=0.7],-3
*TG2х2,TG2х2
A,15,-3,[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=0.5],-2,
[ШТРИХ_ВЕРТИКАЛЬНЫЙ,STRICH.shx,s=0.5],-3
*Zona,Zona
A,10,[US,US.shx,s=1],10
*Zona2,Zona2
A,10,[US,US.shx,s=1],2,[US,US.shx,s=1],10
*ZonaX2,->>-
A,10,[US,US.shx,s=1],4,[US,US.shx,s=1],10
*Изомощность6,Изомощность6
A,0.1,[VB,VB.shx,s=1.5],4,[VB,VB.shx,s=1.5],4,[VB,VB.shx,s=1.5],4,
[VB,VB.shx,s=1.5],4,[VB,VB.shx,s=1.5],4,[VB,VB.shx,s=1.5],4,[VB,VB.shx,s=1.5],-2
*ЛЕЖ_КРЫЛОх5,
A,15,-2.5,[KREST,KREST.SHX,s=1],-2.5
*граница_расщепления,граница расщепления ---- V ---- V ---- V ----
A,30,-5.08,["V",Standard,s=2.54,x=-2.54,y=-1.27],-5.08
*изозола30%,изозола30% ---- 30% ---- 30% ---- 30% ----
A,50,-7.08,["30%",Standard,s=2.54,x=-2.54,y=-1.27],-15.08
*изозола35%,изозола35% ---- 35% ---- 35% ---- 35% ----
A,50,-7.08,["35%",Standard,s=2.54,x=-2.54,y=-1.27],-15.08
*негодный,негодный ---- H ---- H ---- H ----
A,30,-5.08,["H",Standard,s=2.54,x=-2.54,y=-1.27],-5.08
*опасная,опасная ---- ОЗ ---- ОЗ ---- ОЗ ----
A,30,-5.08,["ОЗ",Standard,s=2.54,x=-2.54,y=-1.27],-10
*отщепление,отщепление
A,4,[VB,VB.shx,s=1.5],4,-2
*первая_очередь,первая очередь отработки ---- П ---- П ---- П -
A,30,-5.08,["П",Standard,s=2.54,x=-2.54,y=-1.27],-5.08
*поверхность,\/\/\/\/\/\/\/\
A,2.5,[P,Sam_shp.SHX,s=0.15],4.5,[P1,Sam_shp.SHX,s=0.15],4.5,
[P2,Sam_shp.SHX,s=0.15],1
*треуг,
A,15,-1,["Δ",Simvol,s=2,y=-0.5],-2.5
*штрих_с_точкой,ISO ш/пункт. (дл. штрихи) ____ . ____ . ____ .
A,24,-3,0,-3

Сохраняем линии в файл *.lin. Создаём новый dwg файл в директории с файлами форм, автокад сам их подгрузит, при загрузке линий. Поскольку в файле присутствует линия "треуг", использующая в описании Unicode символ, то выбираем кодировку файла Unicode и создаём стиль "Simvol" в чертеже. В файле присутствуют линии использующие формы. Линии, использующие форму "ШТРИХ_ВЕРТИКАЛЬНЫЙ" скорее всего не загрузятся. Если посмотреть загруженные формы после попытки загрузки линий, то можно увидеть, что файл форм "STRICH.shx" содержит форму "ØÒÐÈÕ_ÂÅÐÒÈÊÀËÜÍÛÉ", что есть "ШТРИХ_ВЕРТИКАЛЬНЫЙ" на Unicode. Если попытаться вставить форму "ШТРИХ_ВЕРТИКАЛЬНЫЙ" команда "_Shape" выдаст ошибку. При вставке формы "ØÒÐÈÕ_ÂÅÐÒÈÊÀËÜÍÛÉ" ошибка не появляется. Соответственно, для того чтобы использовать эту форму в линиях необходимо поменять этой форме имя, причём сделать это лучше латиницой. Следует иметь в виду, что такая модификация может повлиять негативно на какую-то совместимость чертежей использующих этот тип линий с разными именами форм.
Касательно пути к файлу форм в описании линии. Если создавать линию академически, то есть писать файл ручками, то естественно никакого пути писать не нужно (только имя файла), это указано и в хелпере. Появление пути в типе линии скорее всего связано с использованием альтернативных методов создания линий. Среди собранных примеров файлов в этой теме можно в них найти линии, начинающиеся с отрицательных чисел в описании. Такую линию, записанную в файл *.lin невозможно загрузить в чертёж, поскольку по правилам линия всегда должна начинаться со штриха/точки, но в файлах примерах они прекрасно существуют и рисуются.
koMon вне форума  
Ответ
Вернуться   Форум 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