Lisp. Создание слоя(слоёв) из мастер-списка. Изменения в программу CLAY от JefferyPSanders - Страница 2
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Создание слоя(слоёв) из мастер-списка. Изменения в программу CLAY от JefferyPSanders

Lisp. Создание слоя(слоёв) из мастер-списка. Изменения в программу CLAY от JefferyPSanders

Ответ
Поиск в этой теме
Непрочитано 12.03.2012, 14:41
Lisp. Создание слоя(слоёв) из мастер-списка. Изменения в программу CLAY от JefferyPSanders
99xt1
 
нефтепереработка
 
Мозырь, Республика Беларусь
Регистрация: 17.11.2009
Сообщений: 77

Здесь нашёл LISP для быстрого создания определённых слоёв в чертеже.
Код:
[Выделить все]
 
;;;--- CLAY.lsp - Create layer(s) from a Master List [ Master.txt ]
;;;
;;;
;;;--- Created on 2/27/04 by Jeffery P Sanders
;;;
;;;
;;;--- Modified on 5/3/05
;;;
;;;
;;;
;;;--- Please read the txt file CLAY_README.txt


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   Sort Function   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Usage (srt list)
;;;
(defun srt(alist / n)(setq lcup nil rcup nil)
 (defun cts(a b)
  (cond
   ((> a b)t)
   ((= a b )t)
   (t nil)
 ))
 (foreach n alist
  (while (and rcup(cts n(car rcup)))(setq lcup(cons(car rcup)lcup)rcup(cdr rcup)))
   (while (and lcup(cts(car lcup)n))(setq rcup(cons(car lcup)rcup)lcup(cdr lcup)))
   (setq rcup(cons n rcup))
 )
 (append(reverse lcup)rcup)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;  End of Sort Function  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;; Function to save the dialog box settings  ;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun saveVars()

  ;;;--- Setup a list to hold the selected items
  (setq layList(list))

  ;;;--- Save the list setting
  (setq readlist(get_tile "layerlist")) 

  ;;;--- Setup a variable to run through the list
  (setq count 1)

  ;;;--- Cycle through the list getting all of the selected items
  (while (setq item (read readlist))
    (setq layList(append layList (list (nth item layerList))))
    (while 
      (and
        (/= " " (substr readlist count 1))
        (/= ""  (substr readlist count 1))
      )
      (setq count (1+ count))
    )
    (setq readlist (substr readlist count))
  )
)

;;;;;;;;;;;;;;;;;;;;;;; End of saving settings from dialog box ;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;    Function to get a list of all layer names   ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getLayerInfo()

  ;;;--- Set up an empty list
  (setq layerList(list))

  ;;;--- Open the text file
  (if (findfile "MASTER.txt")
    (progn

      (if (setq fil(open (findfile "MASTER.txt") "r"))
        (progn

          ;;;--- Skip the first three lines        
          (read-line fil)
          (read-line fil)
          (read-line fil)

          ;;;--- Read the lines of data in the text file
          (while (setq a (read-line fil))
        
            ;;;--- Get the color
            (setq b(read-line fil))
     
            ;;;--- Get the linetype
            (setq c(read-line fil))

            ;;;--- Add the data to the list
            (setq layerList
              (append 
                layerList
                (list (list a b c))
              )
            )
          )
          ;;;--- Close the file.
          (close fil)
        )
      )
    )
  )

  ;;;--- Sort the list
  ;(setq layerList(srt layerList))
 
  layerList
)
;;;;;;;;;;;;;;;;;;;;;; End of layer listing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;888;;;;;;;888;;;;;;;;;;888;;;;;;;;;;;8888888;;;;;;8888;;;888;;;;;;;;;;;;
;;;;;;;;8888;;;;;8888;;;;;;;;;88888;;;;;;;;;;;;888;;;;;;;;88888;;888;;;;;;;;;;;;
;;;;;;;;88888;;;88888;;;;;;;;888;888;;;;;;;;;;;888;;;;;;;;888888;888;;;;;;;;;;;;
;;;;;;;;888888;888888;;;;;;;888;;;888;;;;;;;;;;888;;;;;;;;888;888888;;;;;;;;;;;;
;;;;;;;;888;88888;888;;;;;;88888888888;;;;;;;;;888;;;;;;;;888;;88888;;;;;;;;;;;;
;;;;;;;;888;;888;;888;;;;;888;;;;;;;888;;;;;;8888888;;;;;;888;;;8888;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;888;;;;;;;;;;;;888888888;;;;;;;;888888888;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;88888;;;;;;;;;;;888;;;888;;;;;;;;888;;;888;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;888;888;;;;;;;;;;888;;;888;;;;;;;;888;;;888;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;888;;;888;;;;;;;;;888888888;;;;;;;;888888888;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;88888888888;;;;;;;;888;;;;;;;;;;;;;;888;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;888;;;;;;;888;;;;;;;888;;;;;;;;;;;;;;888;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:CLAY(/ layerList)

  ;;;--- Turn off the command echo
  (setvar "cmdecho" 0)

  ;;;--- Preset an exit string
  (setq alertStr "\n CLAY.lsp Complete!")

  ;;;--- Get the layer names
  (setq layerList(getLayerInfo))

  ;;;--- If a master list was found
  (if layerList
    (progn

      ;;;--- Load the DCL file
      (setq dcl_id (load_dialog "CLAY.dcl"))
 
      ;;;--- See if the dialog box is already loaded
      (if (not (new_dialog "CLAY" dcl_id))
        (progn
          (alert "The CLAY.DCL file was not found!")
          (exit)
        )
      )

      ;;;--- Get the layer names
      (setq layNames(list))
      (foreach a layerList
        (setq layNames(append layNames(list (car a))))
      )

      ;;;--- Add the layer names to the dialog box
      (start_list "layerlist" 3)
      (mapcar 'add_list layNames)
      (end_list)

      ;;;--- If an action event occurs, do this function
      (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
      (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)") 

      ;;;--- Display the dialog box
      (start_dialog)

      ;;;--- If the cancel button was pressed
      (if (= ddiag 1)

        ;;;--- Set an exit message
        (setq alertStr "\n \n ...CLAY Cancelled. \n ")
      )
  
      ;;;--- If the "Okay" button was pressed
      (if (= ddiag 2)
        (progn
            
          ;;;--- If layers were selected from the dialog box
          (if(> (length layList) 0)
            (progn

              ;;;--- Cycle through each layer selected
              (foreach a layList

                ;;;--- If the layer does not exist
                (if(not(tblsearch "LAYER" (car a)))
                  (progn
       
                    ;;;--- Creat the layer
                    (command "-layer" "new" (car a) "C" (cadr a) (car a) "Lt" (caddr a) (car a) "")

                    (princ "\nCreated Layer  - ")
                    (princ (car a))
                  )

                  ;;;--- Else the layer already exist so modify it's properties
                  (progn

                    ;;;--- Modify the layer
                    (command "-layer" "C" (cadr a) (car a) "Lt" (caddr a) (car a) "")

                    (princ "\nModified Layer - ")
                    (princ (car a))

                  )
                )
              )
            )
          )
        )
      )

      ;;;--- Print the exit message
      (princ alertStr)
    )

    ;;;--- If a master list was not generated, inform the user
    (progn

       (setq alertStr "The MASTER list was not found.\nMake sure the file [ MASTER.txt ] is in your search\npath and try again!")
       (setq alertStr (strcat alertStr "\n\nThe master list must be in this format:\n\nLayerName\nColor\nLineType"))
       (setq alertStr (strcat alertStr "\nLayerName\nColor\nLineType\nect.\n\nNote: The program will skip the first three lines."))
       (alert alertStr)
    )
  )

  ;;;--- reset the command echo
  (setvar "cmdecho" 1)

  ;;;--- suppress the last echo for a clean exit
  (princ)

)  
Содержимое файла master.txt
Код:
[Выделить все]
Layer Name - Do not delete
Color      - Do not delete
Line Type  - Do not delete
STR
1
Continuous
DIM
3
Continuous
STEEL
5
Continuous
REBAR
6
Continuous
CONCRETE
4
Continuous
ANCHOR_BOLT
2
Hidden
BUILDING
8
Continuous
TXT
7
Continuous
WELD
9
Continuous
HOLE
10
Continuous
Как изменить LISP, чтобы была возможность в файле master.txt 4-ой строкой задавать также вес линий слоя, а 5-ой - печатать или не печатать слой?
Просмотров: 13644
 
Непрочитано 03.02.2013, 16:46
#21
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 349


Цитата:
Сообщение от VVA Посмотреть сообщение
Предыдущий вариант с выбором
Извините, а можно всё-таки сделать так, чтобы в этом варианте (файл MakeLayers.lsp вместе с файлом Layers.txt) присутствовали и состояние слоя (заморозка и т. д.), и поле "Description"? А то я попытался сам внести дополнения, и всё вообще перестало работать...
Archeo вне форума  
 
Непрочитано 05.02.2013, 19:47
#22
sdv79

Инженер ЭОМ
 
Регистрация: 05.03.2009
Москва
Сообщений: 215
Отправить сообщение для sdv79 с помощью Skype™


Код:
[Выделить все]
 


;|
----------------------------------------------------
 Программа создает LAYER (слой)
 Автор:		Дмитрий Сологубов
 Телефон:	+7-905-755-44-00
 E-mail:	Sologubov.D.V@gmail.com
 Final 17.01.13
 [rev.1 от xx.xx.10]
 Процедура_обращения

(c:createLayer
	name		; название		"EOM_выноски_размеры_текст"
	color		; цвет			(list 255 255 255) или 255
	ploter		; печатаемость		0 непечатаемый 1 печатаемый
	thickness	; толщина		-3 по умолчанию 0.4
	PlotStyleName	; имя стиля печати	"Style 1"  или  "Normal"
)
или
(c:createLayer "Light_выноски_размеры_текст" (list 150 150 0) 1 0.13  "Style 1")
или
(c:createLayer "Light_НП" (list 255 255 255) 0 0.13  "Normal")
 ----------------------------------------------------
|;

(defun c:createLayer
       (
	Name		; название		"EOM_выноски_размеры_текст"
	Color		; цвет			(list 255 255 255) или 255
	Plottable	; печатаемость		0 непечатаемый 1 печатаемый
	Lineweight	; вес линий		-3 по умолчанию 0.4
	PlotStyleName	; имя стиля печати	"Style 1"  или  "Normal"
	/
       )
; для теста
;;;(vla-get-name(vla-get-ActiveLayer (vla-get-activedocument (vlax-get-acad-object))))
;;;(vlax-get-property (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "0") "Plottable")
;;;(setq lay (entget (tblobjname "LAYER" "Light_выноски_размеры_текст" )))
;;;(assoc 370 lay)
;;;(setq 	name "11"
;;;      	color (list 255 255 255) ; (list 255 255 255)  r g b color 160
;;;      	ploter 1
;;;      	thickness 0.4
;;;  	PlotStyleName	"Style 1"
;;;) ;/ setq
  
 (if(tblsearch "LAYER" Name) ; если есть такой слой то alert
;|1|; (alert "Слой не создан, т.к он уже существует") 
 
;|2|; (progn
       (entmakex 
        (list ; см DXF Reference AutoCAD 2011.pdf смр. 43
          (vl-list* 0   "LAYER") ;'(0 . "LAYER")
          (vl-list* 100 "AcDbSymbolTableRecord") 
          (vl-list* 100 "AcDbLayerTableRecord") 
          (vl-list* 2   Name)
          (vl-list* 70  0)
         (if(listp Color) ; если СПИСКОК цветов, то
;|2-1|;   (vl-list* 420 (+
	                 (lsh (car  Color)16) ; RED
  		         (lsh (cadr Color) 8) ; GREEN
  		         (caddr Color)	      ; BLUE
 	                ) ;/ +
          ) ;/ vl-list*
;|2-2|;   (vl-list* 62  Color)
         ) ;/ if
          (vl-list* 6   "Continuous")    ; Continuous соответствует Normal
          (vl-list* 290 Plottable) 	 ; 0- непечатаемый 1 печатаемый
         (if (= Lineweight -3)		 ; толщина по умолчанию
;|2-1|;   (vl-list* 370 -3) 		
;|2-2|;   (vl-list* 370 (fix(* Lineweight 100)))
         ) ;/ if
        ) ;/ list
       ) ;/ entmakex
      
       (vlax-put-property ; формируем стиль печати  "PlotStyleName"
        (vla-item
         (vla-get-layers
          (vla-get-activedocument
           (vlax-get-acad-object)
          ) ;/ vla-get-activedocument
         ) ;/ vla-get-layers
         Name
        ) ;/ vla-item
        "PlotStyleName" ; acadauto.chm-Layer object-Properties (выбираем нужное)
        PlotStyleName 
       ) ;/ vla-item
       
      ) ;/ progn
      
   ) ;/ if

;| не удалять пример создания слоя, выводит служебную информ. в ком. строку, не очень
  ; запросы из ACAD-а при создании слоя
  ; [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/PStyle/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: 
    (command	"_.layer" 					; вызов команды для создания слоя
		"_Make"				"Light_заливка"	; создаем слой Light_светильники
		"_Color"	255		"Light_заливка"	; устанавливаем цвет
		"_LWeight"	0.13		"Light_заливка"	; вес линии
		"_PStyle"	"Normal"	"Light_заливка"	; стиль печати
		""
    );/ command вместо "" можно использовать \e
    (command "_.layer" "_S" "Light_НП" "") ; делаем активным слой
|;
  
) ;/ defun (c:createLayer ...
sdv79 вне форума  
 
Непрочитано 05.02.2013, 20:15
#23
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


для создания слоев пакетно удобно использовать скрипты, их и писать проще и быстрее, чем изобретать такой велосипед
gomer вне форума  
 
Непрочитано 01.12.2014, 10:33 sdv79
#24
perpetule


 
Регистрация: 23.09.2008
Волгоград
Сообщений: 805
<phrase 1= Отправить сообщение для perpetule с помощью Skype™


http://autolisp.ru/wp-content/upload...er-by-file.lsp
__________________
tc71
perpetule вне форума  
 
Непрочитано 01.12.2014, 12:24
#25
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


А просто воспользоваться Диспетчером слоев невозможно? Или на "худой" конец командой "-Слой" ("_-LAYER")?
Неужели для того, чтобы создать 1 слой надо городить такую хрень, как в сообщении #22?
Profan вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Создание слоя(слоёв) из мастер-списка. Изменения в программу CLAY от JefferyPSanders

Реклама i


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP создание списка из text 4ertegn1k LISP 10 09.03.2011 15:32
{Конкурс} Lisp. Задачки для студентов gomer LISP 10 05.01.2011 16:33