Программы

Расстановка выносок - AutoLISP код

     
;;; Отдельная выноска (часть для программы "кабельный журнал")
;;; Создано RIES.PRO для ООО "Промстройпроект"
;;; Распространяется бесплатно
;;; Skype RIES.PRO
;;; www.RIES.PRO
(vl-load-com)													; подгружаем vl функции
(setq lde "leader_v24_05_16") 									; выноска должна присутствовать
(setvar "ATTREQ" 0)												; убрать запрос значений атрибутов
(setq val "0_E") 												; нужная видимость в дин. блоке. 
(progn															; начало все функции для работы с дин. блоками Lee Mac
  ;; Get Dynamic Block Property Value  -  Lee Mac
  ;; Returns the value of a Dynamic Block property (if present)
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; prp - [str] Dynamic Block property name (case-insensitive)
  (defun LM:getdynpropvalue (blk prp)
    (setq prp (strcase prp))
    (vl-some '(lambda (x)
		(if (= prp (strcase (vla-get-propertyname x)))
		  (vlax-get x 'value)
		)
	      )
	     (vlax-invoke blk 'getdynamicblockproperties)
    )
  )
  ;; Set Dynamic Block Property Value  -  Lee Mac
  ;; Modifies the value of a Dynamic Block property (if present)
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; prp - [str] Dynamic Block property name (case-insensitive)
  ;; val - [any] New value for property
  ;; Returns: [any] New value if successful, else nil
  (defun LM:setdynpropvalue (blk prp val)
    (setq prp (strcase prp))
    (vl-some
      '(lambda (x)
	 (if (= prp (strcase (vla-get-propertyname x)))
	   (progn
	     (vla-put-value
	       x
	       (vlax-make-variant
		 val
		 (vlax-variant-type (vla-get-value x))
	       )
	     )
	     (cond (val)
		   (t)
	     )
	   )
	 )
       )
      (vlax-invoke blk 'getdynamicblockproperties)
    )
  )
  ;; Get Dynamic Block Properties  -  Lee Mac
  ;; Returns an association list of Dynamic Block properties & values.
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; Returns: [lst] association list of (( . ) ... )
  (defun LM:getdynprops	(blk)
    (mapcar '(lambda (x)
	       (cons (vla-get-propertyname x) (vlax-get x 'value))
	     )
	    (vlax-invoke blk 'getdynamicblockproperties)
    )
  )
  ;; Set Dynamic Block Properties  -  Lee Mac
  ;; Modifies values of Dynamic Block properties using a supplied association list.
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; lst - [lst] association list of (( . ) ... )
  ;; Returns: nil
  (defun LM:setdynprops	(blk lst / itm)
    (setq
      lst (mapcar '(lambda (x) (cons (strcase (car x)) (cdr x))) lst)
    )
    (foreach x (vlax-invoke blk 'getdynamicblockproperties)
      (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst))
	(vla-put-value
	  x
	  (vlax-make-variant
	    (cdr itm)
	    (vlax-variant-type (vla-get-value x))
	  )
	)
      )
    )
  )
  ;; Get Dynamic Block Property Allowed Values  -  Lee Mac
  ;; Returns the allowed values for a specific Dynamic Block property.
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; prp - [str] Dynamic Block property name (case-insensitive)
  ;; Returns: [lst] List of allowed values for property, else nil if no restrictions
  (defun LM:getdynpropallowedvalues (blk prp)
    (setq prp (strcase prp))
    (vl-some '(lambda (x)
		(if (= prp (strcase (vla-get-propertyname x)))
		  (vlax-get x 'allowedvalues)
		)
	      )
	     (vlax-invoke blk 'getdynamicblockproperties)
    )
  )
  ;; Toggle Dynamic Block Flip State  -  Lee Mac
  ;; Toggles the Flip parameter if present in a supplied Dynamic Block.
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; Return: [int] New Flip Parameter value
  (defun LM:toggleflipstate (blk)
    (vl-some
      '(lambda (prp / rtn)
	 (if (equal '(0 1) (vlax-get prp 'allowedvalues))
	   (progn
	     (vla-put-value
	       prp
	       (vlax-make-variant
		 (setq rtn (- 1 (vlax-get prp 'value)))
		 vlax-vbinteger
	       )
	     )
	     rtn
	   )
	 )
       )
      (vlax-invoke blk 'getdynamicblockproperties)
    )
  )
  ;; Get Visibility Parameter Name  -  Lee Mac
  ;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; Returns: [str] Name of Visibility Parameter, else nil
  (defun LM:getvisibilityparametername (blk / vis)
    (if
      (and
	(vlax-property-available-p blk 'effectivename)
	(setq blk
	       (vla-item
		 (vla-get-blocks (vla-get-document blk))
		 (vla-get-effectivename blk)
	       )
	)
	(= :vlax-true (vla-get-isdynamicblock blk))
	(= :vlax-true (vla-get-hasextensiondictionary blk))
	(setq vis
	       (vl-some
		 '(lambda (pair)
		    (if
		      (and
			(= 360 (car pair))
			(= "BLOCKVISIBILITYPARAMETER"
			   (cdr (assoc 0 (entget (cdr pair))))
			)  
		      )
		       (cdr pair)
		    )
		  )
		 (dictsearch
		   (vlax-vla-object->ename (vla-getextensiondictionary blk))
		   "ACAD_ENHANCEDBLOCK"
		 )
	       )
	)
      )
       (cdr (assoc 301 (entget vis)))
    )
  )
  ;; Get Dynamic Block Visibility State  -  Lee Mac
  ;; Returns the value of the Visibility Parameter of a Dynamic Block (if present)
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; Returns: [str] Value of Visibility Parameter, else nil
  (defun LM:getvisibilitystate (blk)
    (LM:getdynpropvalue blk (LM:getvisibilityparametername blk))
  )
  ;; Set Dynamic Block Visibility State  -  Lee Mac
  ;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed)
  ;; blk - [vla] VLA Dynamic Block Reference object
  ;; val - [str] Visibility State Parameter value
  ;; Returns: [str] New value of Visibility Parameter, else nil
  (defun LM:SetVisibilityState (blk val / vis)
    (if
      (and
	(setq vis (LM:getvisibilityparametername blk))
	(member	(strcase val)
		(mapcar 'strcase (LM:getdynpropallowedvalues blk vis))
	)
      )
       (LM:setdynpropvalue blk vis val)
    )
  )
  
)																; конец все функции Lee Mac	
(defun prp_blk () 												; прикрепление выноски к блоку вычислением угла и расстояния
	(setq dist (distance pt_x pt_blk))						; расстояние между точками вставки блока и выноски
	(setq angle_blk (angle pt_x pt_blk))							; угол между точками вставки блока и выноски
	(LM:setdynpropvalue blk "Расстояние3" dist)					; записываем значение в динамический блок
	(LM:setdynpropvalue blk "Угол1" angle_blk)				; записываем значение в динамический блок
)
(repeat 100													; цикл на 100 выносок
	(princ "Выберите блок")(terpri)							; сообщение
	(setq s (entsel))											; выбрать блок
	(setq blk (entnext (car s))) 								; взяли блок
	(setq pt_blk (cadr s))									; переписали правильно координаты блока
	(setq pt_x (getpoint "Точка выноски: "))(terpri)				; точка вставки выноски
	(setq zna_E1 (cdr (assoc '1(entget blk)))) 					; значение атрибута Name
	(command "_.-insert" lde pt_x "1" "1" "0") 					; уставили новый блок "1" ;масштаб по оси X "1" ;масштаб по оси Y "0" ;угол поворота
	(setq a (entlast))											; вызов последнего элемента т.е. вставленного блока
	(progn														; объединяем в блок-кода
		(setq a1 (entnext a)) 									; положили в а1 список атрибутов
		(setq b1 (cdr (assoc '2 (entget a1)))) 					; взяли название атрибута
		(setq blk (vlax-ename->vla-object a))					; превратили в vla объект
		(LM:SetVisibilityState blk val)							; установили видимость из памяти
		(setq b1 (subst (cons 1 (strcat "поз. " zna_E1)) (assoc '1 (entget a1)) (entget a1))) 		; записали NAME
		(entmod b1) (entupd a1) 																		; перерисовали
	)
	(if (> (nth 0 pt_blk) (nth 0 pt_x)) 																; если блок правее точки вставки выноски
		(progn																						; объединяем в блок-кода
			(LM:setdynpropvalue blk "Отраженное состояние1" 1)									; меняем свойство в динамическом блоке
			(setq 																				; точка вставки блока с поправкой на динамическое отражение в блоке
				pt_blk (list 
							(+ (nth 0 pt_blk) (* (ABS(- (nth 0 pt_x) (nth 0 pt_blk))) 2)) 			; X
							(nth 1 pt_blk) 															; Y
							(nth 2 pt_blk)															; Z
						)
			)
		)
	)
	(prp_blk)																						; функция выбора нового блока
)



	

Тэги: AutoLISP

Добавить комментарий

Администратор оставляет за собой право удалять любой комментарий без разъяснения.


Защитный код
Обновить