[bengan777]

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

Код:

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

  (defun C:Nplne (/ pt pt1 pt2 pt4 ent ent2 lst_point sys_var htxt mysset counter n coun2 temp)
  (vl-load-com)
  (setq Htxt 2) ;_Высота текста
  (setq sys_var (mapcar 'getvar '("osmode" "cmdecho")))	; Сохранение значений системных переменных
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if (not (numberp *NPoint*))(setq *NPoint* 1))	; Проверка, пуста ли глобальная переменная *NPoint*
  (princ "\nНачальный номер <")(princ *NPoint*)(princ ">: ")
  (if (null (setq n (getint)))(setq n *NPoint*))	; Возможность ввести начальный номер руками
 (setq mysset (ssget))	; Выбор набора объектов
 (setq counter 0)
 (while (< counter (sslength mysset))	; Начало перебора объектов набора
    (setq ent (ssname mysset counter))	; Получение координат вершин списком
  (setq  lst_point (mapcar 'cdr				
        (vl-remove-if-not
          '(lambda (x) (= (car x) 10))
          (entget ent)
        ) ;_ end of vl-remove-if-not
      		   ) ;_ end of mapcar
  ) ;_ end of setq
(setq coun2 0)
   (while (< coun2 (length lst_point))
     (setq pt (nth coun2 lst_point))
	(if (= coun2 (- (length lst_point) 1)) (setq pt1 (nth 0 lst_point))
	  (setq pt1 (nth (1+ coun2) lst_point))); координаты следующей вершины
     	 (if (= coun2 0) (setq pt2 (nth coun2 (reverse lst_point)))
	   (setq pt2 (nth (- coun2 1) lst_point))) ; координаты предыдущей вершины
     
       	    (setq pt4 (polar pt (- (angle pt2 pt) (/ (- (angle pt2 pt) (angle pt1 pt)) 2)) 1)); получаем координату смещения на 1 нашего узла к середине внутреннего угла
	(vl-cmdf "_ray" pt4 "@5<90" "") ; Проводим луч из pt2 к северу
	(setq ent2 (entlast)) ; пишем в переменную имя луча
	(setq temp
         (vla-intersectwith
          (vlax-ename->vla-object ent)
          (vlax-ename->vla-object ent2)
          acExtendnone
          )
	 )
	(setq temp
	 (vlax-safearray-get-u-bound
	 (vlax-variant-value temp) 1)
	) ; Получаем количество пересечений (-1 если их нет, 2 если одно, 5 если 2 итд.)
	     (if (= (abs (rem temp 2)) 1)
     		(vl-cmdf "_text" "_none" (polar pt (angle pt pt4) (+ 2 Htxt)) Htxt 0 (itoa n) "")
     		(vl-cmdf "_text" "_none" (polar pt (- (angle pt pt4) 3.1415) (+ 2 Htxt)) Htxt 0 (itoa n) "")
	     ) ; вставляем текст учитывая внутри, или снаружи фигуры находится точка луча
     (vl-cmdf "_erase" ent2 "") ; стираем луч
    (setq coun2 (1+ coun2))
    (setq n (1+ n))
   ); end while
     (setq *Npoint* n)
   (setq counter (+ counter 1))
 );_end of while
  (mapcar 'setvar '("osmode" "cmdecho") sys_var)
  (princ)
) ;_ end of defun
(princ "\nНаберите Nplne в командной строке")

Вроде бы все работает, но один из форумчан обнаружил баг.

Вот координаты фигуры:

4364751.528,5006349.857
4364772.986,5006353.912
4364774.609,5006369.05
4364776.683,5006353.912
4364795.166,5006352.019
4364776.412,5006349.676
4364775.962,5006335.078
4364771.814,5006349.406
Здесь 5 точка оказывается внутри фигуры((

луч в этом случае попадает внутрь фигуры и имеет одно пересечение с ней, однако, программа почему то считает что пересечений 2
(setq temp
(vlax-safearray-get-u-bound
(vlax-variant-value temp) 1)
) выдает в этом случае значение 5

[kp+]

Сообщение от bengan777 однако, программа почему то считает что пересечений 2

Когда объекты находятся где-то далеко от начала координат, например в другой галактике (а они в приведенном примере именно такие), у vla-intersectwith начинаются проблемы с точностью вычислений и получаются такие заскоки
Стоило передвинуть "звездочку" в начало координат, все заработало корректно.
Разбирали сей клинический случай здесь: http://www.theswamp.org/index.php?PH...ic=46848.0;all
Посмотрите, какое из решений в той теме Вам подойдет, возможно из #9, но я его не тестировал.
Может надо написать свое - например при длине массива точек пересечения равной 6 (две точки) выполнить проверку на их одинаковость с некоторой точностью, если совпадут - значит точек на самом деле не две, а одна.

[Бот]

bengan777, просьба изменить название темы "Помогите разобраться с багом программы" в соответствии с п.4.3. правил форума, в противном случае тема будет закрыта через 12 часов.

Как переименовать тему?

Сообщение сгенерировано автоматически, отвечать на него не нужно