[stroygeodezia]

Есть несколько вееров отрезков (вертикальных скважин). Нужно обвести
их по очереди полилинией, затем указав поличенную полилинию, сохранить
в формате DXF AutoCAD 12 в отдельных файлах для ввода в другую программу.

[Дима_]

Ну нужно так обводи - в чем собственно вопрос.

[Uduzr]

) действительно, какого результата ожидал автор?
Если вы хотите чтобы вам в чем либо помогли то надо попросить или спросить...
По теме: приложите хотя бы исходные файлы и ручками созданные варианты того что хотите получить.

[stroygeodezia]

За то, что не встал на колени и не протянул руку для "подачки", извините ВСЕ!!! Просто не корректно сформулировал свой вопрос.
Групп вееров по 5-10 штук около 100 в одном чертеже их 20-50. Руками делать, это...........
Подбросте идею решения. Исходный файл приложу позже. Очищу от лишнего

[VVA]

Посмотри эту тему Создание внешнего контура на основе выделенного набора примитивов

[stroygeodezia]

VVA. Спасибо! Этот код у меня не прошел, но попробую еще раз.
Скорее всего придется самому писать на Лиспе. Многое в нем уже "наваял" по геодезии. Некоторые уже используют давно. Просто хотелось сделать быстрее.А я из родом из Белорусии, а на стройках Мурмана (Хибины) 30 лет.

[VVA]

stroygeodezia, Хотелось бы увидеть "веер отрезков" в виде dwg

[stroygeodezia]

Выкладываю пример чертежа. Веера красным цветом от синего контура штольни.

[Дима_]

Примеры "вееров" прямо скажем не сильно заточенны под автоматизацию как их все "обуздать" лично мне не очень понятно (алгоритм). Для "неперекрещивающихся" попробуй этот лисп - но предварительно отключи все "не веерные" слои - и старайся не зацепить лишнего при выборе. Для перекрещивающихся ихмо надо понять - по какой логиге их сцеплять. Запускать командой veer.

Код:

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

 (vl-load-com)
(defun pln (lst c); создает полилинию по списку вершин lst, c - nil/T - разомкн/замкнт или '(с слой цвет).
  (entmakex (append
             (list (cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline") (cons 90 (length lst)))
             (if (= (type c) 'list)
                 (vl-remove nil (list
                                 (if (car c) (cons 70 1) (cons 70 0))
                                 (if (cadr c) (cons 8 (cadr c)))
                                 (if (caddr c) (cons 62 (caddr c)))
                                 ));end of list & vl-remove
                 (list (if c (cons 70 1) (cons 70 0)))
                 );end of if
             (mapcar '(lambda (x) (cons 10 x)) lst)
             ));end of apend & entmakex
  );end of pln

(defun c:veer ()
  (princ "\n Выберете веер линий ")
  ((lambda (ss adoc cross cross-all-rec cross-filter-rec)
     (if ss 
         (progn
          (vla-startundomark adoc)
          (pln
           (mapcar 'cdr
                   (vl-sort
                    (mapcar '(lambda (lst)
                               ((lambda (x y)
                                  (if (> (cadr x) (cadr y)) (cons y x) (cons x y)))
                                (cdr (assoc 10 lst))
                                (cdr (assoc 11 lst))))
                            (mapcar
                             'entget
                             (mapcar
                              'vlax-vla-object->ename
                              ((lambda (lst)
                                 (cross-filter-rec lst lst))
                               (mapcar
                                'vlax-ename->vla-object
                                (vl-remove-if
                                 'listp
                                 (mapcar 'cadr (ssnamex ss))))))))
                    '(lambda (a b) (> (caar a) (caar b)))))
           nil)
          (vla-endundomark adoc))))
   (ssget '((0 . "line")))
   (vla-get-activedocument (vlax-get-acad-object))  
   (lambda (obj1 obj2)
     (> (vlax-safearray-get-u-bound 
         (vlax-variant-value 
          (vla-IntersectWith obj1 obj2 acExtendThisEntity)) 1) 0))
   (lambda (x lst)
     (if lst
         (if (cross x (car lst))
             T
             (cross-all-rec x (cdr lst)))))
   (lambda (lst1 lst2)
     (if lst1
         (if (cross-all-rec (car lst1) (vl-remove (car lst1) lst2))
             (cross-filter-rec (cdr lst1) lst2)
             (cons (car lst1) (cross-filter-rec (cdr lst1) lst2)))))))

з.ы. если будешь спрашивать корректно и ясно и ответы будут такими же.

[stroygeodezia]

Похоже "ваять" придется самому. В Лиспе не "профи", но соображаю и пишу немного. Времени катастрофически не хватает. "А корова, а хозяйство"

[Олег (jr.)]

Сообщение от stroygeodezia Похоже "ваять" придется самому. В Лиспе не "профи", но соображаю и пишу немного. Времени катастрофически не хватает. "А корова, а хозяйство"

Попробуй в этом направлении

Код:

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

   ;;==============================================================================;;

;; local defuns

;;return value by key
(defun dxf  (key alist)
  (cdr (assoc key alist)
       )
  )
 
;; swap variables
;; fixo ()2008
(defun swap  (a b / c)
  (mapcar 'set
	  (list 'c 'a 'b)
	  (list a b c)
	  )
  )


;;  minimum to entmake lwpolyline - by Michael Puckett
;;            :arguments: a point list flag for close and pline width
            (defun entmakelwpline  (plist flag width)
	      (entmake
		(append
		  (list
		    '(0 . "LWPOLYLINE")
		    '(100 . "AcDbEntity")
		    '(8 . "0")
		    '(100 . "AcDbPolyline")
		    (cons 90 (length plist))	  ;number of verticies
		    (cons 70 flag)
		    (cons 43 width)		  ;constant width
		    )
		  (mapcar '(lambda (x) (cons 10 x)) plist)

		  )
		)
	      )




(defun C:VEER  (/ elist en ep p1 p2 ptarr sp ss)
  (cond	((and (setq p1 (getpoint "\nТочка слева от веера: "))
	      (setq p2 (getpoint p1 "\nТочка справа от веера: "))
	      (setq ss (ssget "_C"
			      p1
			      p2
			      (list (cons 0 "LINE") (cons 8 "скважины"))))
	      )

	 (while	(setq en (ssname ss 0))
	   (setq elist (entget en)
		 sp    (dxf 10 elist)
		 ep    (dxf 11 elist))
	   (cond ((> (- (car sp) (car ep) 0.001))
		  (swap sp ep)))
	   (setq ptarr (cons (cons (angle sp ep) ep) ptarr))
	   (ssdel en ss))
	 (setq ptarr (mapcar 'cdr
			     (vl-sort ptarr '(lambda (a b) (< (car a) (car b))))))
	 (entmakelwpline ptarr 0 0)))
  (princ)
  )

;;==============================================================================;;   

[stroygeodezia]

Олег (jr.). Пока спасибо за подсказку. Но в Вашем "исходнике" у меня отображаются какие-то "аброказябры" вместо русского текста

[Олег (jr.)]

Сообщение от stroygeodezia Олег (jr.). Пока спасибо за подсказку. Но в Вашем "исходнике" у меня отображаются какие-то "аброказябры" вместо русского текста

Забыл что из редактора текст так копируется
И вдогонку: точки лучше указывать с двух сторон ближе
к началу веера

[stroygeodezia]

Олег (jr.)
Почти то, что нужно!!! Но контур должен пройти полностью по верхним и нижним точками линии веера, без команды замыкания. Полилиния проходит из 1-й точки в 1-ю. Начало желательно от верха левой линии веера.
Прошу, если это возможно, добавить вариант записи созданных полилиний (по выбору) в формат DXF 12 с запросом на имя файла.
Ну так нужно!!!!!
"Моя благодарность будет безграничной, в пределах разумного".

[Олег (jr.)]

Сообщение от stroygeodezia Олег (jr.) Почти то, что нужно!!! Но контур должен пройти полностью по верхним и нижним точками линии веера, без команды замыкания. Полилиния проходит из 1-й точки в 1-ю. Начало желательно от верха левой линии веера. Прошу, если это возможно, добавить вариант записи созданных полилиний (по выбору) в формат DXF 12 с запросом на имя файла. Ну так нужно!!!!! "Моя благодарность будет безграничной, в пределах разумного".

Я вообще тупой с малолетства ты мне лучше на рисунке объясни
а то не пойму кто на ком стоял