[Программа отрисовки распила + вопросы по bhatch и trim]

Ax3 · 08.02.2007, 23:58

Всем привет.
Написал я прогу для автоматической отрисовки в AutoCAD`е заданной карты распила бревна на доски
(для станка с двумя перпендикулярно расположенными пильными дисками).
Кому будет интересно - посмотрите как работает. (скачать чертеж с приложением).
Запуск программы - команда cm, перед запуском snap, osnap и ortho должны быть отключены.
Это предварительная версия. Комментарии пока готовлю.

И вот по этому поводу два вопроса.
1. У меня область штриховки задается точкой, отстоящей на 5 мм левее и 5 мм выше (5 мм - толщина полилиний) точки вставки блока, символизирующего пилы (в будущей версии - на 0,1 мм правее и выше точки пересечения горизонтального диска с бревном). Можно ли как-то по-другому задать область штриховки? Объектами, например, без этих миллиметров?
2. У меня отрезаемый сегмент задается fence, которая берет начало на 0,1 мм левее и 0,1 мм выше точки вставки линий, символизирующих линии отреза. Опять же - как обойтись без миллиметров?

Места, где вопросы, в тексте программы отмечены.

На всякий случай отдельно текст программы

Код:

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

;--------------------------------------------------------------------
(setq app_name "Cut_map_acad")
(setq app_ver "1.0")
(setq app_dev "Danilov_AS")
(setq app_begin_date "2007.01.30")
(setq app_1st_release_date "_2007.02.08")
(setq app_cmd_name "cm")
(setq prompt_dev (strcat "\n" app_name "_v" app_ver "(c)" app_dev app_1st_release_date "\n"))
(prompt prompt_dev)
(setq prompt_added_cmd (strcat "_added command `" app_cmd_name "` for drawing cut map\n"))
;(vl-load-com)
;--------------------------------------------------------------------
;--------------------------------------------------------------------
(defun	app_func ()
'--------------------------------------------------------------------
	(setq fdesc (open (strcat fldname "\\cut_map.ass") "r"))
	(setq delay_tr 1)
	(setq pv 5 ph 5)
	(setq d 500 r (* 0.5 d))
	(setq map	(list st szv 20 sl szh 150 tr szh 150 tr szv 50 sl szh 75 tr szh 100 tr szh 100 tr szh 100 tr
			sl szv 250 tr))
	(setq v0w r h0w r)
	(setq n 0 n_max (1- (length map)))
	(command "_erase" "_all" "")
	(command "_ucs" "_world")
	(command "_insert" "saws_dims" (list (- r) r) "" "" "")
	(command "_ucs" "_move" (list h0w v0w))
	(command "_circle" (list r (- r)) r)
	(while (<= n n_max) (cut_f))
	(command "_ucs" "_world")
	(command "_zoom" "_extents")
	(close fdesc)
)
'--------------------------------------------------------------------
(defun	cut_f ()
'--------------------------------------------------------------------
	(setq cmd (nth n map))
	(eval (cmd))
	(prompt "\nSuccessful: ")
	(print cmd)
	(setq n (1+ n))
)
'--------------------------------------------------------------------
(defun	h_cur0_f ()
'--------------------------------------------------------------------
	(- r (sqrt (- (* v_cur0 (+ d v_cur0)))))
)
'--------------------------------------------------------------------
(defun	st ()
'--------------------------------------------------------------------
	(setq v_cur0 0 h_cur0 r)
)
'--------------------------------------------------------------------
(defun	szv ()
'--------------------------------------------------------------------
	(setq n (1+ n))
	(setq v_ (nth n map))
	(setq var_name_ 'v_cur0 dlt_name_ 'v_ p_name_ 'pv sign_ -)
	(sz)
)
'--------------------------------------------------------------------
(defun	szh ()
'--------------------------------------------------------------------
	(setq n (1+ n))
	(setq h_ (nth n map))
	(setq var_name_ 'h_cur0 dlt_name_ 'h_ p_name_ 'ph sign_ +)
	(sz)
)
'--------------------------------------------------------------------
(defun	sz ()
'--------------------------------------------------------------------
	;чтение параметра
	;если параметр отсутствует, то с учетом толщины пропила:
	(setq dlt_ (+ (eval dlt_name_) (eval p_name_)))
	;учет направления оси координат:
	(set var_name_ (sign_ (eval var_name_) dlt_))
)
'--------------------------------------------------------------------
(defun	sl ()
'--------------------------------------------------------------------
	(setq h_cur0 (h_cur0_f))
)
'--------------------------------------------------------------------
(defun	tr ()
'--------------------------------------------------------------------
	(command "_zoom" "_window" (list 0 0) (list d (- d)))
	(command "_copy" "_window" (list 0 0) (list d (- d)) "" (list 0 0) (list (+ d r) 0))
	(setq obj0 (vlax-ename->vla-object (entlast)))
	(setq obj0l (entlast))

;---->
;----? Вопрос здесь. h_cur0, v_cur0 точка вставки блока, символизирующего пилы.
;	 pv, ph - толщина полилинии
;	 Как программно заштриховать сегмент между двумя линиями?
;----> Мой вариант (не очень корректный):
	(command "_insert" "saws" (list h_cur0 v_cur0) "" "" "")
	(command "_bhatch" (list (- h_cur0 ph) (+ v_cur0 pv)) "p" "ansi31" 1 0 "")
	(command "_bhatch" "@0,0" "p" "ansi31" 1 90 "")
;----> То есть область штриховки задается точкой, отстоящей от точки вставки блока пил, на 5 мм влево и на 5 мм вверх

	(command "_ucs" "_move" (list (+ d r) 0))
	(command "_zoom" "_window" (list 0 0) (list d (- d)))
	(setq v0w (+ v0w 0) h0w (+ h0w d r))

	(command "_line" (list h_cur0 v_cur0) (list h_cur0 (+ v_cur0 0.01)) "")
	(setq obj1 (vlax-ename->vla-object (entlast)))
	(setq obj1l (entlast))
	(setq pt_inters1 (vla-intersectwith obj1 obj0 acextendthisentity))
	(setq pt_inters1l (vlax-safearray->list (vlax-variant-value pt_inters1)))
	(setq	var_name_ 'pt_inters1l coord_ 1 sign1_ > sign2_ <= sign3_ +
		var_name1_ 'v0w var_name2_ 'v_cur0 var_name2nd_pt_ 'pt_inters1l2nd)
	(setq n_clpts_ 1)
	(if	(clpt)
		(progn
			(setq sa1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
			(setq pt_inters1 (vlax-make-variant (vlax-safearray-fill sa1 pt_inters1l)))
			(vla-put-endpoint obj1 pt_inters1)
		)
		(progn
			(setq pt_inters1 nil pt_inters1l nil n_clpts_ 2)
			(command "_erase" obj1l "")
		)
	)

	(command "_line" (list h_cur0 v_cur0) (list (- h_cur0 0.01) v_cur0) "")
	(setq obj2 (vlax-ename->vla-object (entlast)))
	(setq obj2l (entlast))
	(setq pt_inters2 (vla-intersectwith obj2 obj0 acextendthisentity))
	(setq pt_inters2l (vlax-safearray->list (vlax-variant-value pt_inters2)))
	(setq	var_name_ 'pt_inters2l coord_ 0 sign1_ < sign2_ >= sign3_ +
		var_name1_ 'h0w var_name2_ 'h_cur0 var_name2nd_pt_ 'pt_inters2l2nd)
	(clpt)
	(setq	sa2 (vlax-make-safearray vlax-vbdouble '(0 . 2))
		pt_inters2 (vlax-make-variant (vlax-safearray-fill sa2 pt_inters2l)))
	(if	(= n_clpts_ 2)
		(setq	sa22nd (vlax-make-safearray vlax-vbdouble '(0 . 2))
			pt_inters22nd (vlax-make-variant (vlax-safearray-fill sa22nd pt_inters2l2nd)))
	)
	(vla-put-endpoint obj2 pt_inters2)
	(if	(= n_clpts_ 2)
		(progn
			(vla-put-startpoint obj2 pt_inters22nd)
			(setq obj1l obj2l obj1 obj2)
		)
	)
;---->
;----? Вопрос здесь. obj1 и obj2 - две линии, символизирующие пилы.
;	 obj0 - полилиния, символизирующая бревно.
;	 Как программно вырезать сегмент между двумя линиями?
;----> Мой вариант (не очень корректный):
	(command "_trim" obj1l obj2l ""
		"_fence" 	(list (- h_cur0 0.1) (+ v_cur0 0.1)) 
				(list (- h_cur0 0.1) 0) ""
		"_fence"	(list (- h_cur0 0.1) (+ v_cur0 0.1))
				(list 0 (+ v_cur0 0.1)) "" ""
	)
;----> То есть выступ размером менее 0.1 мм не обрежется

	(if	(= (cdr (assoc 0 (entget obj0l))) "LWPOLYLINE")
		(command "_pedit" obj0l "_join" obj1l obj2l "" "")
		(command "_pedit" obj0l "_yes" "_join" obj1l obj2l "" "")
	)
	;(setq v0w (+ v0w d) h0w (+ h0w 0))
)
'--------------------------------------------------------------------
(defun	clpt ()
'--------------------------------------------------------------------
	(setq temp_ (eval var_name_))
	(setq n_pts_ (/ (length temp_) 3) val_ (nth coord_ temp_) num_ nil)
	(setq i_ 0)
	(repeat n_pts_
		(setq x_ (nth (+ coord_ i_) temp_))
		(if	(sign1_ x_ val_)
			(setq val_ x_)
		)
		(setq i_ (+ 3 i_))
	)
	(setq i_ 0)
	(repeat n_pts_
		(setq x_ (nth (+ coord_ i_) temp_))
		(if	(and (sign1_ x_ (sign3_ (eval var_name1_) (eval var_name2_))) (sign2_ x_ val_))
			(setq val_ x_ num_ i_)
		)
		(setq i_ (+ 3 i_))
	)
	(set	var_name_
		(if	num_
			(list (nth num_ temp_) (nth (1+ num_) temp_) (nth (+ 2 num_) temp_))
			nil
		)
	)
	(setq i_ 0 new_x_ val_ val_ (nth coord_ temp_))
	(repeat n_pts_
		(setq x_ (nth (+ coord_ i_) temp_))
		(if	(and (sign1_ x_ new_x_) (sign2_ x_ val_))
			(setq val_ x_ num_ i_)
		)
		(setq i_ (+ 3 i_))
	)
	(set	var_name2nd_pt_
		(if	num_
			(list (nth num_ temp_) (nth (1+ num_) temp_) (nth (+ 2 num_) temp_))
			nil
		)
	)
)
'--------------------------------------------------------------------
(vlax-add-cmd app_cmd_name 'app_func (strcat app_cmd_name "_loc") 1)
;--------------------------------------------------------------------
(prompt prompt_added_cmd)
(prompt "_load success")

[ATTACH]1170968307.rar[/ATTACH]
---
Для формирования кода используй тэги [code] и [/code]

Кулик Алексей aka kpblc · 09.02.2007, 08:51

C ходу несколько предложений (уж прости, но подробно код смотреть не получается - некогда

)
1. Постарайся не использовать глобальные переменные без крайней на то нужды.
Например, после выхода из app_func все ее переменные (fldname, fdesc, delay_tr, pv, ph и т.п.) останутся болтаться в памяти. А это может привести к немного непредсказуемым последствиям.
2. Системные переменные и работу с ними засовывай в обработчик ошибок. Один из вариантов такого обработчика болтается на http://www.arcada.com.ua/forum/viewtopic.php?t=445
3. Для программной штриховки можно попробовать ее просто создавать через entmake либо через vla-фукнции. Что одно, что другое - требует анализа точек вершин.
4. Строки

Код:

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

(setq pt_inters1 (vla-intersectwith obj1 obj0 acextendthisentity))
  (setq pt_inters1l (vlax-safearray->list (vlax-variant-value pt_inters1)))

Вроде бы и ничего, но у тебя нет анализа - а что если пересечения нет? Ситуация маловероятная, но все же...
5 Зачем использовать

Код:

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

(command "_line" (list h_cur0 v_cur0) (list (- h_cur0 0.01) v_cur0) "")
  (setq obj2 (vlax-ename->vla-object (entlast)))

Когда можно нечто типа:

Код:

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

(setq obj2 (vlax-ename->vla-object
             (entmakex (list (cons 0 "LINE")
                             (cons 10 (list h_cur0 v_cur0))
                             (cons 11 (list (- h_cur0 0.01) v_cur0))
                             ) ;_ end of list
                       ) ;_ end of entmakex
             ) ;_ end of vlax-ename->vla-object
      ) ;_ end of setq

Кстати, при таком подходе не надо отключать osmode

6. Вместо (command "_.trim") можно опять же попробовать получить точки пересечения примитивов (через vla-intersectwith, с опцией acextendnone), и по ним строить новые примитивы.
---
Вообще-то странно - ты там такие навороты activex-ные используешь, и тут же (command). Обычно (command) используется когда уже совсем край, а создание примитивов лично я к таким задачам отнести не могу...

Ax3 · 09.02.2007, 09:08

Что я могу сказать... Наспех составлял. :-)
Спасибо. Обязательно учту.

Ax3 · 14.02.2007, 23:49

Всем доброго времени суток.
Представляю первую рабочую версию программы.
Отличается только тем, что добавлена проверка наличия пересечения вертикального диска (или его продолжения) с бревном. Для горизонтального это не требуется по условию (ниже/выше бревна он не опускается/не поднимается). kpblc, еще раз спасибо за рекомендации, пока, как видишь, учел только одну, остальные - потом. Очень уж не терпелось показать миру свое (!рабочее!) произведение.
Краткие инструкции. Скачать архив, распаковать, открыть чертеж и выполнить команду cm.
Буду рад отзывам и пожеланиям.
[ATTACH]1171486195.rar[/ATTACH]
З.Ы. Да, и чуть не забыл. Проверено в AutoCAD2004en и AutoCAD2006ru.

Кулик Алексей aka kpblc · 15.02.2007, 09:54

Сразу, с наскоку, несколько моментов:
1. acaddoc.lsp использовать не рекомендую - у пользователя могут быть там прописаны свои вещи. ИМХО: лучше сделать собственную менюшку, и в mnl прописать замену acaddoc.lsp
2. Нет никакого встроенного readme.
3. inters.lsp - чего выполняет? Кроме того, там нет отслеживания отсутствия пересечения.
4. Насчет именования глобальных переменных. Раз уж от них отказаться не получается, я бы рекомендовал использовать такое:
app_name -> заменить на *ax3-app-name*
app_ver -> *ax3-app-ver*
ну и так далее.
К сожалению, полностью перерабатывать код я не могу.

Ax3 · 15.02.2007, 10:04

Да, работы хватит на несколько версий вперед...

Благодарю. С меня - пиво (?).
P.S. Кстати, inters.lsp - я его просто забыл удалить. :wink: