Вставка блока с размером линии

Вставка блока с размером линии · 18.05.2013, 16:06

пытаюсь упростить вычерчивание аксанаметрий. В последовательную цепочку линий вставить блок с размером и диаметром трубы. Но вот беда, бьюсь уж день третий, а ошибку все равно выдает. Подскажите где затыка, я так подозреваю, что в организации набора ss_new, но может где-то еще.

Код:

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

;		ВСТАВКА РАЗМЕРА ЛИНИИ
(defun mvo ()
	;==================================
	(setq t1 nil)		
	(setq t2 nil)		
	(setq ug nil)		
	(setq i nil)		
	;==================================
	;(setq n_l (ssadd))
	;(setq ss_new (ssadd))
	(setq n_l (ssget))		
	(setq t1 (cdr (assoc 10 (entget (ssname n_l 0)))))	;начальная точка рассматриваемой линии
	(setq t2 (cdr (assoc 11 (entget (ssname n_l 0)))))	;конечная точка рассматриваемой линии
)
;*************************************************************************************************
(defun lk ()	

	(setq dl (distance t1 t2))	;длинна рассматриваемой линии
	(setq ug (/ (* (angle t1 t2) 180) pi))	;угол поворота рассматриваемой линии
	(setq tz (polar t1 (angle t1 t2) (/ dl 2)))
	(princ)
)
;*************************************************************************************************
(defun roty ()				
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ У
	(if (> (atof (rtos (car t1) 2 2)) (atof (rtos (car t2) 2 2)))
		(setq ug (- ug 180))
	)
	(princ)
)
;*************************************************************************************************
(defun rotx ()
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ Х
	(if (> (atof (rtos (cadr t1) 2 2)) (atof (rtos (cadr t2) 2 2)))
		(setq ug (- ug 180))
	)
	(princ)
)
;*************************************************************************************************
(defun rotz ()
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ Z
	(command "_ucs" "y" "")
	(setq t1 (trans t1 0 1))	;начальная точка рассматриваемой линии
	(setq t2 (trans t2 0 1)) 	;конечная точка рассматриваемой линии
	(setq dl (distance t1 t2))	;длинна рассматриваемой линии
	(setq ug (/ (* (angle t1 t2) 180) pi))	;угол поворота рассматриваемой линии
	(setq tz (polar t1 (angle t1 t2) (/ dl 2)))
	(roty)
	(vstb)
	(princ)
)
;*************************************************************************************************
(defun vstb (/ i obj ent_d ent sub_ent en)
	(setq i 10)
	(setvar "attreq" 0)
	(setvar "cmdecho" 0)
	(command "_insert" "razm" tz "1" "1" ug)
	(setq obj (entlast))
	(setq ent_d (entget obj))
		(if (= "INSERT" (cdr (assoc 0 ent_d)))
			(progn
				(setq ent_d (cdr (assoc 2 ent_d)))
				(setq sub_ent (tblsearch "BLOCK" ent_d))
				(setq ent (cdr (assoc -2 sub_ent)))
					(while (/= i 1)
						(if (= "RAZMER" (cdr (assoc 2 (entget ent))))
							(progn
								(setq en (entget ent))
								(setq en (subst (cons 1 (rtos dl 2 0)) (assoc 1 en) en))
								(entmod en)
								(entdel obj)									; удаления блока 
								(command "_insert" "razm" tz "1" "1" ug)
								; отрисовка по новой для измения блока
								(setq i 1)	; СЧЕТЧИК
							)
						)		
						(setq ent (entnext ent))
					)
			)
		)
	(princ)
)
;*************************************************************************************************
(defun per_lin (/ m ss_new kontrol t1_new obj_new)
	(setq m 1)	;	счетчик для while
	(setq kontrol "aa")
	(setq ss_new (ssget "_c" tz t2))
		(while (not (equal kontrol "eureka"))
			(repeat (sslength ss_new)
				(if (not (equal "LINE" (cdr (assoc 0 (entget (ssname ss_new (- m 1)))))))
					(ssdel (ssname ss_new (- m 1)) ss_new)
				)
					(setq m (+ m 1))
			)
			(setq m 1)
			(setq lnab (sslength ss_new))
				(repeat (sslength ss_new)
					(setq t1_new (cdr (assoc 10 (entget (ssname ss_new (- m 1))))))
					(if (equal t2 t1_new 0.0)
						(progn
							(setq t1 t1_new)
							(setq t2 (cdr (assoc 11 (entget (ssname ss_new (- m 1))))))
							(setq obj_new (ssname ss_new (- m 1)))
							(setq kontrol "eureka")
							(lk)
						)
					)
					(setq m (+ m 1))
				)
		)
	(setq n_l (ssadd))
	(setq n_l (ssadd obj_new n_l))
	(princ)	
)
;*************************************************************************************************
(defun c:lkl ();(/ n_l t1 t2 dl ug tz)
	(mvo)
	(lk)
	(while (not (equal (sslength n_l) 0))
		(if (not (equal (caddr t1) (caddr t2))) 
			(progn
				(rotz)
				(setq t1 (trans t1 1 0))	; вернули координаты в МИР для дальнейшего использования
				(setq t2 (trans t2 1 0))
				(setq tz (trans tz 1 0))
				(command "_ucs" "_w")
			)
				(progn
					(roty)
					(rotx)
					(vstb)
				)
		)
		(per_lin)
	)	
	(getvar "cmdecho")
	(princ)
)
;*************************************************************************************************

Олег (jr.) · 18.05.2013, 22:31

Навскидку, не вижу где у тебя установлена привяка на ноль,
когда ты что-то рисуешь в документе, это чаще всего основная проблема
в начале сохрани значение OSMODE, затем установи OSMODE = 0,
а в конце программы восстанови исходное значение

nolte · 18.05.2013, 23:02

Да не, проблема не в точке вставки блока, он как раз ставиться как надо и поворачивается правильно и длину определяет все путьком. Проблема в том, что если чертишь штук двенадцать линий одна за другой, то лисп выполняется раз до второй линии, раз до десятой. Нет никакой закономерности. Да, привинчу ка я файлик автокада, дабы не утруждать отвечающих созданием блока.

Олег (jr.) · 19.05.2013, 11:47

При выборе на экране все поле должно быть видимым,
На скорую руку добавил откат и зуммирование, также
нужно проверять размер набора чтобы он не был равен нулю,
кароч нужно долго ковырять, у меня времени нет

Код:

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

;		ВСТАВКА РАЗМЕРА ЛИНИИ
(defun mvo ()
	;==================================
	(setq t1 nil)		
	(setq t2 nil)		
	(setq ug nil)		
	(setq i nil)		
	;==================================
	;(setq n_l (ssadd))
	;(setq ss_new (ssadd))
	(setq n_l (ssget))		
	(setq t1 (cdr (assoc 10 (entget (ssname n_l 0)))))	;начальная точка рассматриваемой линии
	(setq t2 (cdr (assoc 11 (entget (ssname n_l 0)))))	;конечная точка рассматриваемой линии
)
;*************************************************************************************************
(defun lk ()	

	(setq dl (distance t1 t2))	;длинна рассматриваемой линии
	(setq ug (/ (* (angle t1 t2) 180) pi))	;угол поворота рассматриваемой линии
	(setq tz (polar t1 (angle t1 t2) (/ dl 2)))
	(princ)
)
;*************************************************************************************************
(defun roty ()				
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ У
	(if (> (atof (rtos (car t1) 2 2)) (atof (rtos (car t2) 2 2)))
		(setq ug (- ug 180))
	)
	(princ)
)
;*************************************************************************************************
(defun rotx ()
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ Х
	(if (> (atof (rtos (cadr t1) 2 2)) (atof (rtos (cadr t2) 2 2)))
		(setq ug (- ug 180))
	)
	(princ)
)
;*************************************************************************************************
(defun rotz ()
	; ПОВОРОТ БЛОКА ЕСЛИ ЛИНИЯ ТОЛЬКО ПО ОСИ Z
	(command "_ucs" "y" "")
	(setq t1 (trans t1 0 1))	;начальная точка рассматриваемой линии
	(setq t2 (trans t2 0 1)) 	;конечная точка рассматриваемой линии
	(setq dl (distance t1 t2))	;длинна рассматриваемой линии
	(setq ug (/ (* (angle t1 t2) 180) pi))	;угол поворота рассматриваемой линии
	(setq tz (polar t1 (angle t1 t2) (/ dl 2)))
	(roty)
	(vstb)
	(princ)
)
;*************************************************************************************************
(defun vstb (/ i obj ent_d ent sub_ent en)
	(setq i 10)
	(setvar "attreq" 0)
	(setvar "cmdecho" 0)
	(command "_insert" "razm" tz "1" "1" ug)
	(setq obj (entlast))
	(setq ent_d (entget obj))
		(if (= "INSERT" (cdr (assoc 0 ent_d)))
			(progn
				(setq ent_d (cdr (assoc 2 ent_d)))
				(setq sub_ent (tblsearch "BLOCK" ent_d))
				(setq ent (cdr (assoc -2 sub_ent)))
					(while (/= i 1)
						(if (= "RAZMER" (cdr (assoc 2 (entget ent))))
							(progn
								(setq en (entget ent))
								(setq en (subst (cons 1 (rtos dl 2 0)) (assoc 1 en) en))
								(entmod en)
								(entdel obj)									; удаления блока 
								(command "_insert" "razm" tz "1" "1" ug)
								; отрисовка по новой для измения блока
								(setq i 1)	; СЧЕТЧИК
							)
						)		
						(setq ent (entnext ent))
					)
			)
		)
	(princ)
)
;*************************************************************************************************
(defun per_lin (/ m ss_new kontrol t1_new obj_new)
	(setq m 1)	;	счетчик для while
	;|(setq kontrol "aa")|;(setq kontrol T)
	(if (ssget "_c" tz t2 (list (cons 0 "line")));|(setq ss_new (ssget "_c" tz t2))|;
	  (progn
	    (command "_zoom" "_e")
		(while (not kontrol);|(not (equal kontrol "eureka"))|;
		(if (/= 0(sslength ss_new))(progn	(repeat (sslength ss_new)
				(if (not (equal "LINE" (cdr (assoc 0 (entget (ssname ss_new (- m 1)))))))
					(ssdel (ssname ss_new (- m 1)) ss_new)
				)
					(setq m (+ m 1))
			)
					     )
		  )
		  
			(setq m 1)
			(setq lnab (sslength ss_new))
				(repeat (sslength ss_new)
					(setq t1_new (cdr (assoc 10 (entget (ssname ss_new (- m 1))))))
					(if (equal t2 t1_new 0.0)
						(progn
							(setq t1 t1_new)
							(setq t2 (cdr (assoc 11 (entget (ssname ss_new (- m 1))))))
							(setq obj_new (ssname ss_new (- m 1)))
							(setq kontrol nil);|(setq kontrol "eureka")|;
							(lk)
						)
					)
					(setq m (+ m 1))
				)
		)
	     (command "_zoom" "_P")
	    )
	  )

	(setq n_l (ssadd))
	(if obj_new(setq n_l (ssadd obj_new n_l)))
	(princ)	
)
;*************************************************************************************************
(defun c:lkl (/ *error* cme osm );(/ n_l t1 t2 dl ug tz)
  (defun *error* (s)
    (vl-bt)
    (princ s))
  (setq osm (getvar "osmode"))(setvar "osmode" 0)
  (setq cme (getvar "cmdecho"))(setvar "cmdecho" 0)
  (command "_undo" "_be")
	(mvo)
	(lk)
	(while (not (equal (sslength n_l) 0))
		(if (not (equal (caddr t1) (caddr t2))) 
			(progn
				(rotz)
				(setq t1 (trans t1 1 0))	; вернули координаты в МИР для дальнейшего использования
				(setq t2 (trans t2 1 0))
				(setq tz (trans tz 1 0))
				(command "_ucs" "_w")
			)
				(progn
					(roty)
					(rotx)
					(vstb)
				)
		)
		(per_lin)
	)	
	
  (setvar "osmode" osm)
  (setvar "osmode" cme)
  (command "_undo" "_e")
	(princ)
)
;*************************************************************************************************
;; Только для проверки из редактора:
(C:lkl)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
вставка блока со смещенными атрибутами в .NET	2san	.NET	10	06.07.2012 00:03
Вставка блока во все layout	serg01	Программирование	2	30.09.2009 08:59
Вставка таблицы внутри анонимного блока	Кулик Алексей aka kpblc	Программирование	7	21.06.2006 15:05
Вставка блока	Vladlen	AutoCAD	5	25.05.2006 09:42
вставка блока с переопределением	Net	AutoCAD	17	25.04.2006 18:17

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск