[xatkash]

Добрый день!

Уважаемы программисты, помогите решить задачу. Мне нужен LISP-скрипт для AutoCAD, который выполняет следующие функции:

Работает как стандартная команда "ОТРЕЗОК":
Указание первой точки активирует рисование линии с визуальным отображением направления.
Позволяет указывать следующие точки либо вводить расстояние, как в стандартной команде "ОТРЕЗОК".

Автоматически вставляет блоки:
Блок (например, "WELL") вставляется в первую точку и в каждую конечную точку линии.

Поддерживает отмену (Ctrl+Z):
Если отменяется последний сегмент линии, соответствующий блок также удаляется.

Работает на нескольких сегментах:
После завершения одного сегмента (нажатием Enter), можно начать новый сегмент с новой точки.
Блоки должны вставляться корректно в каждом новом сегменте.

Дополнительная информация:

Я использую русскую версию AutoCAD.
Название блока: "WELL" (блок уже создан в чертеже).
Основная команда для рисования — _LINE.

Я уже пытался реализовать этот скрипт, но столкнулся с двумя проблемами:

Блоки не удаляются при отмене (Ctrl+Z).
На новом сегменте блок вставляется только в первую и вторую точки, но не в последующие.
Вот загружаю текущую версию скрипта, который частично работает.
Заранее благодарю за помощь.

[Кулик Алексей aka kpblc]

1. Кодировка файла должна быть Windows-1251, а не UTF-8, как у тебя
2. Про грабли уже много раз рассказывали.
3. Метки начала и конца отмены проставить не помешает
4. Вместо while t лично я бы использовал нечто типа

Код:

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

   (while 
    (and 
      (= 
        (type 
          (setq firstPoint (vl-catch-all-apply 
                             (function 
                               (lambda () 
                                 (getpoint "\nУкажите первую точку <Отмена> : ")
                               )
                             )
                           )
          )
        )
        'list
      )
      firstPoint
    )
    ;; Запрашиваем первую точку
    ; (setq firstPoint (getpoint "\nУкажите первую точку (или нажмите Enter для завершения): "))
    ; (if (not firstPoint) (exit)) ; Завершение команды, если Enter нажата без ввода точки

5. Лично я предпочитаю в лиспе (exit) не использовать - как-то не лежит у меня к этой функции душа.

[koMon]

Сообщение от xatkash помощь

Код:

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

 
(defun c:pipedraw (/ start_point line_list command_ended next_point)
	(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "well")))
		(princ "\nБлок \"Well\" не определён в чертеже.")
		(progn
  			(setq start_point (getpoint "\nНачальная точка, <Esc> отмена: ")
				  line_list (append line_list (list (list (vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
  			   												   		 	   (vlax-3d-point start_point)
  			   												  		 	   "well" 1 1 1 0
														  )
													)
  											  )
							)
			)
  			(while (and (not command_ended)
						(setq next_point (vl-catch-all-apply 'getpoint (list "\nСледующая точка, <Esc> отмена: " (if (null line_list) start_point (vlax-get (car (last line_list)) 'insertionpoint)))))
				   )
  					(cond
						((null (vl-catch-all-error-p next_point))
   							(setq line_list (append line_list (list (list (vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
  								         									        	   (vlax-3d-point next_point)
  								         									        	   "well" 1 1 1 0
  								         								  )
																		  (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
  								                									   (if (null line_list) (vlax-3d-point start_point) (vla-get-insertionpoint (car (last line_list))))
  								                									   (vlax-3d-point next_point)
  								         								  )
  								            						)
  								         					   )
  								  			)
   							)
  						)
  						((vl-catch-all-error-p next_point)
  							 (mapcar 'vla-erase (last line_list))
							 (princ "...отменено...")
  							 (setq line_list (vl-remove (last line_list) line_list))
							 (if (null line_list) (progn (princ "\nВсё отменено.") (setq command_ended t))) 
  						)
					)
  			)
			(if (null next_point) (princ "\nКоманда завершена.")) 
		)
	)
	(princ)
)