Проникающая гидроизоляция бетона
Показать сообщение отдельно
 
Непрочитано 09.02.2010, 14:18
#190
Positron


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


Цитата:
Сообщение от nik_mb Посмотреть сообщение
Полностью исправленный лисп-файл (правда, мною немного поковерканый) и чертеж-двг, как пример.
Пробуй. У меня работает.
Запустил чертёж, там работают твои слоя и стили, но как непойму, я перед этим лисп даже не загрузил в автокад...
Когда загрузил в автозагрузку лисп со своими натсройками(красным), то оно неработает:

Код:
[Выделить все]
 ;; Перенесение заданных примитивов (размеры, штриховка, текст) на заданный слой

(if (not ActiveDocument)
  (setq ActiveDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
 ) ;_ end of if

(if *vlr-cmd*
  (progn (setq *vlr-cmd* nil)(vlr-remove-all :vlr-command-reactor)) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)(setq *vlr-cmd*
(vlr-command-reactor "cmd" '(
		      (:vlr-commandwillstart . cmd-start)
		      (:vlr-commandended . cmd-end)
		      (:vlr-commandcancelled . cmd-cancel)
		      (:vlr-commandfailed . cmd-fail)
		      )
		    ) ;_ end of VLR-Command-Reactor
	) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. Не может быть пропущено
   ("color" . 3)         ; номер цвета. nil -> 7
   ("lw" . 50)         ; вес линии слоя. nil -> 25
   ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   )
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
(setq vla_layer (vla-add (vla-get-layers ActiveDocument)
	   (cdr (assoc "name" layer-list))
	   ) ;_ end of vla-add
	) ;_ end of setq
  (vla-put-color vla_layer 
    (if	(cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if	(cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
	   (_kpblc-linetype-load
	     (cdr (assoc "lt" layer-list))
	     (cdr (assoc "ltfile" layer-list))
	     ) ;_ end of _kpblc-linetype-load
	   ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if	(= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer ActiveDocument)
		  vla_layer
		  ) ;_ end of equal
	   ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react	cmd / selset   cmd_name ent
		  svr res tag text index _attreq_  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
(setq *dim_style* (strcase (getvar "dimstyle")))
(cond
((vl-string-search "dim" cmd_name)(setq *vlr-settings* (list (cons "layer" (vla-get-activelayer ActiveDocument)) ;_ end of cons
  	(cons "color" (getvar "cecolor"))
	(cons "lw" (getvar "celweight"))
	(cons "lt" (getvar "celtype")) ) ;_ end of list
	   ) ;_ end of setq
(cond
((= *dim_style* "01_1x1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x1)")("color" . 140)("lw" . 20)))))
((= *dim_style* "02_1x2")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x2)")("color" . 140)("lw" . 20)))))
((= *dim_style* "03_1x4")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "04_1x5")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "05_1x8")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "06_1x10")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "07_1x16")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "08_1x20")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "09_1x30")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "10_1x40")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "11_G1x1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
);;cond
(mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)(setq *vlr-settings*
	    (list (cons	"layer" (vla-get-activelayer ActiveDocument)	) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "Штриховка")("color" . 190)("lw" . 15)) ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype")'("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings* (list (cons	"layer" (vla-get-activelayer ActiveDocument)	) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "Текст")("color" . 150)("lw" . 25))) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react  cmd  / list_obj selset  item counter leader_item cmd_name
		leader_item_list up_string low_string )
  (setq	cmd_name (strcase (car cmd) t) 	counter	 0 ) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   ActiveDocument
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   ActiveDocument
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается — он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq	ltype_list '(("center" . "осевая")
		     ("center2" . "осевая2")
		     ("hidden" . "скрытая")
		     ("hidden2" . "скрытая2")
		     )
	ltype-name (strcase ltype-name t)
	) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
			(vl-catch-all-apply
			  'vla-load
			  (list
			    (vlax-get-property
			      (vla-get-ActiveDocument (vlax-get-acad-object))
			      'linetypes
			      ) ;_ end of vlax-get-property
			    ltype_normal
			    ltype-file
			    ) ;_ end of list
			  ) ;_ end of vl-catch-all-apply
			) ;_ end of vl-catch-all-error-p
		      ) ;_ end of not
	  ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun

Последний раз редактировалось Кулик Алексей aka kpblc, 16.11.2012 в 13:46.
Positron вне форума  
 
Размещение рекламы