| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

Новые команды для работы с полилинией

Ответ
Поиск в этой теме
Непрочитано 14.09.2006, 13:30 4 |
Новые команды для работы с полилинией
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,991

Данный набор программ является коллективным продуктом участников форумов autocad.ru и dwg.ru с моими доработками.
Захотелось собрать все программы для работы с полилиниями воедино и оформить как полагается.

=========== Доступные команды PLTOOLS=================
Редакция 17.06.2014
PL-JOIN -Объединение выбранных полилиний
PL-VFI -вставка вершин в выбранной полилинии в местах пересечения с
указанными полилиниями, линиями, дугами
PL-JOIN3D -Объединение 3D полилиний
PL-L2A -Замена линейного сегмента в полилинии дуговым сегментом.
PL-A2L -Замена дугового сегмента в полилинии линейным сегментом.
PL-DIV -Разбивает выбранный сегмент полилинии на указанное количество
сегментов или через указанное расстояние
PL-DIVAll -Разбивает все сегменты полилинии на указанное количество
сегментов или через указанное расстояние
PL-VxAdd -Добавляет новую вершину к полилинии
ENTREVS -Реверс объекта
ENTREV -Реверс объектов (множественный выбор)
PL-CW -Реверс выбранных полилиний по часовой стрелке
PL-CCW -Реверс выбранных полилиний против часовой стрелки
PL-VxRdc -Удаление вершин полилиний, которые лежат на одной прямой
PL-VxDel -Удаление выбранной вершины
pl-VxOpt -Удаление совпадающих вершин из полилинии
PL-NoArc -Аппроксимация дуговых сегментов полилинии
PL-Clone -Построение полилинии путем копирования ее сегментов
PL-VxMove -Перемещение вершин полилинии
PL-Vx1 -Изменение начала полилинии
ConvTo2d -Преобразование линейных объектов в 2D полилинии
ConvTo3d -Преобразование линейных объектов в 3D полилинии
MPL -Построение средней линии Более продвинутая версия Rollin_Ball.lsp Find MidBoundary between two polylines.
R3P -Прямоугольгик по 3-м точкам
PL-P90 -Рисование перпендикулярных друг к другу сегментов полилинии
PL-CSE -Объединение 2d полилиний по примитиву
PL-SgWidth -Изменить ширину сегмента полилинии

Реверс дуговых сегментов полилинии из #79
На дуговых сегментах полилинии тип линий может быть "вверх тормашками", причем реверс не помогает. Этот артефакт можно побороть, если в полилинии включить "генерацию типа линий".

Панели, лисп и инструкции здесь http://dwg.ru/dnl/607
Иконки для темной темы здесь
Обсуждаем, критикуем, предлагаем

Миниатюры
Нажмите на изображение для увеличения
Название: plrevers.jpg
Просмотров: 15409
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 08.09.2023 в 13:25. Причина: ссылка на иконки для темной темы
Просмотров: 368890
 
Непрочитано 24.11.2006, 17:23
#61
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,737


Спасибо
Кочетков Андрей вне форума  
 
Непрочитано 27.11.2006, 14:36
#62
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


Спасибо, но есть еще вопросы
а нельзя ли сделать так чтоб угол не вводить каждый раз. Типа как в акаде рисование окружности - старое значение по умолчанию
Neznayka вне форума  
 
Автор темы   Непрочитано 27.11.2006, 15:54
#63
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90+- допуск градусов 
;;;За основу берется самая длинная сторона 
;;;http://forum.dwg.ru/showthread.php?p=104952#post104952
(Defun C:p90 ( / Flg e1 i ang *error* crs pt0 pt1 pt2 pt3 var adoc dop1 dop2) 
(defun *error* (msg)(princ msg)(vla-endundomark adoc)) 
(defun angw1w2 (Wekt1 Wekt2 $P000 / CosA) 
(setq Wekt1 (mapcar '- Wekt1 $P000) Wekt2 (mapcar '- Wekt2 $P000) $P000 (mapcar '- $P000 $P000)) 
 (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2)) 
  (distance $P000 Wekt1) (distance $P000 Wekt2))) -1.0 1e-6) Pi 
  (if (equal CosA 0.0 1e-6) Pi2 (atan (sqrt (- 1 (* CosA CosA))) CosA)))) 
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates) 
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline") 
             (group-by-num verts 3)) 
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil)))) 
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn 
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) 
(setq ret (append ret (list (reverse ls))) ls nil)))) ret) 
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq ang *P90-ANG*)(princ"\nДопуск в градусах для выравнивания до 90 [Любой] <")(initget "Любой Any _Any Any")
(princ (if ang (/ (* ang 180.0) pi) "любой угол"))(princ">: ")(setq ang (getangle))
(if (= ang "Any")(setq ang nil *P90-ANG* nil))(if ang (setq *P90-ANG* ang))
(if ang (setq dop1 (- (* 0.5 PI) ang) dop2  (+ (* 0.5 PI) ang)) 
(setq dop1 nil dop2 nil))(VL-PROPAGATE '*P90-ANG*) 
(princ "\nВыберите полилинии ")(setq selset (ssget "_:L" '((0 . "*POLYLINE")))) 
(if selset (progn (setq selset (mapcar 'vlax-ename->vla-object  (vl-remove-if 'listp 
 (mapcar 'cadr (ssnamex selset))))) 
 (mapcar '(lambda(vobj / ug ptS ptE)(setq crs (pline-get-verts vobj)) 
    (if   (> (length crs) 2)(progn (setq Pt1 nil pt2 nil ptS nil ptE nil var nil) 
   (setq pt1 (car crs))(mapcar '(lambda (x)(if (or (null var) (< var (distance pt1 x))) 
        (setq var (distance pt1 x) ptS pt1 ptE x))  (setq pt1 x))(cdr crs))(setq i 0 var 0) 
   (while (and i (nth i crs))(if (and (equal (nth i crs) ptS 1e-6) 
               (equal (nth (1+ i) crs) ptE 1e-6))(setq var (1+ i) i (+ (length crs) 1))) 
       (setq i (1+ i))) 
   (if (> var (* 0.5 (length crs)))(setq crs (reverse crs) i ptS ptS ptE ptE i)) 
   (setq var nil i 0 lst crs) 
   (while (and i (nth i crs)) 
     (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6)) 
       (setq i nil)(setq var (append var (list (nth i crs))) 
        i   (1+ i) lst (cdr lst)))) 
   (setq crs (append lst var))(setq ang (angle (car crs) (cadr crs))) 
   (setq lst (list (car crs) (cadr crs)) crs (cddr crs)) 
   (foreach pt crs (setq pt1 (last lst)) 
     (setq pt2 (polar pt ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100)) 
     (setq ug (angw1w2 pt (cadr (reverse lst)) pt1)) 
     (if (or (null dop1)(and (> ug dop1)(< ug dop2))) 
       (setq pt0 (inters pt pt2 pt1 pt3 nil))(setq pt0 pt)) 
     (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0))) 
   (setq crs (reverse lst))(setq ang (angle (car lst) (cadr lst))) 
   (if (or   (equal (angle (car crs) (cadr crs)) ang 1e-6) 
      (equal (angle (car crs) (cadr crs)) (+ ang PI) 1e-6) 
      (equal (angle (car crs) (cadr crs)) (- ang PI) 1e-6)) 
     (progn (setq pt1 (car lst))(setq pt0 (car crs))(setq pt2 (polar pt0 ang 100)) 
       (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt0 pt2 pt1 pt3 nil)) 
       (setq lst (append (reverse (cdr crs)) (list pt0))) 
       (vla-put-Closed vobj :vlax-true)) 
     (progn (setq pt1 (car crs))(setq pt2 (cadr crs)) 
       (setq pt0 (inters (car lst) (cadr lst) pt1 pt2 nil)) 
       (if   (and pt0 (equal (angle pt2 pt1) (angle pt2 pt0) 1e-6)) 
         (progn (setq pt1 (polar (car lst) (+ ang (* 0.5 PI)) 100)) 
           (setq pt0 (inters pt2 (polar pt2 ang 100) (car lst) pt1 nil)) 
           (setq crs (cddr crs))(setq crs (append (list pt0) crs)) 
           (setq lst (reverse crs))(vla-put-Closed vobj :vlax-true))))) 
   (if (= (vla-get-ObjectName vobj) "AcDbPolyline") 
     (setq lst (mapcar '(lambda (cr) (mapcar '+ cr '(0 0))) lst))) 
   (setq crs (apply 'append lst))(setq var (vlax-make-variant (vlax-safearray-fill 
        (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length crs)))) crs))) 
   (vla-put-Coordinates vobj var)))) selset))) ;_selset 
(vla-endundomark adoc)(princ))(princ "\nНаберите в командной строке p90")
Значение сохраняется в текущем сеансе редактирования

Последний раз редактировалось VVA, 19.09.2015 в 21:00.
VVA вне форума  
 
Непрочитано 18.12.2006, 11:49
#64
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Выражаю особую благодарность VVA за программу "Прополка полиинии". Очень пригодилась для значительного уменьшения количества вершин полилиний после выполнения таких преобразований: CDR->DWG->WMF->DWG.
Profan вне форума  
 
Непрочитано 18.12.2006, 13:22
#65
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Для VVA.
В вашей функции PL-L2A есть запрос:
Код:
[Выделить все]
Выберите нужный дуговой сегмент в полилинии [отмени U/радиус R/выход X] <выход>:
Наверное, надо слово "дуговой" заменить на "линейный"?
Profan вне форума  
 
Автор темы   Непрочитано 14.03.2007, 10:46
#66
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Profan Спасибо, Владимир. Как-то пропустил твой пост, только сейчас заметил. Заменил. Исправления от 14.03.2007
Помимо этого добавлено:
ConvTo2d -Преобразование линейных объектов в 2D полилинии
ConvTo3d -Преобразование линейных объектов в 3D полилинии
MPL -Построение средней линии
R3P -Прямоугольгик по 3-м точкам
PL-JOIN -Объединение полилиний чохом (если есть 3d полилинии, то объединяет и их тоже, но не с 2d, а между собой)
PL-JOIN3D -Объединение 3D полилиний (Отрезки + 3d полилинии)
Исправлены мелкие и не очень (спасибо KAI) глюки.
VVA вне форума  
 
Непрочитано 15.03.2007, 01:03
#67
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Цитата:
Исправлены мелкие и не очень (спасибо KAI) глюки.
Правда еще более маленькие появились, но это мелочи.
Даже мне, зунуде, кажется, что уже все в норме. Есть конечно мелкие огрехи, кое в чем с автором я не согласен, но на то и АВТОР! Ему видней.
А в целом комплекс ОЧЕНЬ хороший! Рекомендую!
Огромное спасибо VVA!
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 15.03.2007, 06:35
#68
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Для VVA.
Вот ЗДЕСЬ есть еще программа Евгения Елпанова "Изменение начальной и конечной ширины произвольного сегмента полилинии". Вы не хотите включить ее или ваш аналог в пакет PLTOOLS?
Правильно вы сделали, что сгруппировали кнопки.
Profan вне форума  
 
Автор темы   Непрочитано 18.04.2007, 18:25
#69
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Поступают просьбы добавить команду, чтоб выбирать надо было бы только один объект, а команда объединяла все примыкающие объекты (линии, полилинии, дуги...) в полилинию.
Выкладываю на тестирование и для предложений/замечаний.
Алгорити взят у ChainSelect Fatty
Код:
[Выделить все]
;;* Утилита объединения набора линий в полилинию*
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - точка в мировой системе координат !!!
;;    - или имя (ENAME VLA-OBJECT) начального примитива
;; fuzz - точность
;;Возвращает список vla объектов
(defun ChainSelectFromAny ( pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil
             )
       )
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I")
          ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))
    ) ;_ end of setq
  (progn
    (if pt
      (progn
        (setq ln1 (vla-addLine
                    (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
                             (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))
                             ) ;_ end of and
                      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-3d-point pt)
               (vlax-3d-point (mapcar '- pt '(1 1 0)))))
        (setq ln ln1)))
     (setq spt (vlax-curve-getStartPoint ln)
           ept (vlax-curve-getEndPoint ln))
    (setq line_list  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (cons ln chain_list)
    ) ;_ end of setq
    (setq line_list (vl-remove-if
                      '(lambda (x)
                         (eq "AcDb3dPolyline" (vla-get-objectname x))
                       ) ;_ end of lambda
                      line_list
                    ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq loop t cycl 0)
    (while loop
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
         (if couple
           (progn
             (setq chain_list (append couple chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq ln (car chain_list))
           ) ;_ end of progn
           (setq line_list (cdr line_list))
         ) ;_ end of if
      ) ;_ end of while
      (setq loop nil)
    ) ;_ end of while
  ) ;_ end of progn
) ;_ end of if
  (setq chain_list (vl-remove ln1 chain_list))
  (if (= (type ln1) 'VLA-OBJECT)(vl-catch-all-apply 'vla-erase (list ln1)))
  (vl-cmdf "_.redraw")
  chain_list
)


;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:mark
;;;* Mark data base to allow KB:catch.
;;;*http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
   (setq val (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast))
      nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)
      )
   )
   (setvar "cmdecho" val)
   (princ)
)
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:catch
;;;* returns selection set of entities since last KB:mark.
;;;*
(defun mip:get-last-ss (/ ss tmp)
   (if *mip:mark
      (progn (setq ss (ssadd))
             (while (setq *mip:mark (entnext *mip:mark)) (ssadd *mip:mark ss))
             (command "._select" ss "")
             (setq tmp ss)
      )
      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
   )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------



(defun C:CSS ( / ss pda en fuzz)
 (vl-load-com)
 (if (and (setq en (car(entsel "\nВыбрать первую или последнюю линию в цепи :")))
          (wcmatch (cdr(assoc 0 (entget en))) "ARC,LINE,*POLYLINE"))
 (progn
 (if (null (setq fuzz (getdist "\nЗначение допуска < 0.01 >: ")))
   (setq fuzz 0.01))
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss)
    )
  (mip:mark)
  (vl-catch-all-apply '(lambda()
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    )
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))

  (setq ss nil)
  )
   )
  (princ)
  )
(defun C:CSP ( / ss pt1 pda lst fuzz)
 (vl-load-com)  
 (initget 1)
 (setq pt1 (getpoint "\nТочка начала объединения:"))
  (if (null (setq fuzz (getdist "\nЗначение допуска < 0.01 >: ")))
   (setq fuzz 0.01))
 
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny (trans pt1 1 0)(+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss)
    )
  (mip:mark)
  (vl-catch-all-apply '(lambda()
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    )
  (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))
;;;  (setq ln (entlast))
;;;  (if (and (wcmatch (cdr(assoc 0 (entget ln))) "*POLYLINE")
;;;           (not(lwcl ln)))
;;;           (plineLW-reverse ln))
  (setq ss nil)
  (princ)
  )

(princ "\nНаберите CSP или CSS в командной строке")
Две команды
CSS - объединение путем выбора притива
CSP - объединение путем указания точки
VVA вне форума  
 
Непрочитано 19.04.2007, 03:15
#70
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
Очень интересно! Но:

0. Мур-мур от команд надо-бы отключить.

1. CSS. В одном из моих отладочных чертежей вылезла следующая ошибка (правда там объекты отрисованы в разных UCS и ужасная мешанина из объектов):

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
; error: bad argument value: AcDbCurve 2130505112

2. CSS. 3DPoly следует исключать из набора, иначе получается следующая картина:

---3DPoly в конце цепочки------------

Command: css
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
_.redraw
Command: _pedit Select polyline or [Multiple]: _M
Select objects: 9 found

Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]: _j
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: _j
Enter join type [Extend/Add/Both] <Both>: _b
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: 0.010000000000000
8 segments added to polyline

Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]:
Command: ._select
Select objects: 0 found
Select objects:

---3DPoly в начале----------------------

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
_.redraw
Command: _pedit Select polyline or [Multiple]: _M
Select objects: 10 found

Select objects:
Enter an option [Close/Open/Spline curve/Decurve/Undo]: _j
Invalid option keyword.

Enter an option [Close/Open/Spline curve/Decurve/Undo]: ._select
Invalid option keyword.
; error: Function cancelled

Enter an option [Close/Open/Spline curve/Decurve/Undo]:

3. CSP. Похоже точку надо указывать точно на узле объекта?

4. Для PEDITACCEPT лучше применять конструкцию:
(if (getvar "PEDITACCEPT");для 2006>>
(progn
(setq pda (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
)
)
Вдруг прогу запустят в acad 2005?

5. CSS. Кроме 3DPoly, думаю следует проверять еще и линии (они должны лежать в одной плоскости), а то получается, что грипсы загораются на всей цепочке, но это только видимость! Если последняя линия не в плоскости полилинии.

6. На мой взгляд, fuzz по умолчанию лучше бы сделать 0.0, будем приучать пользователей к точности.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 19.04.2007, 11:50
#71
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> 0. Мур-мур от команд надо-бы отключить
Извини, не понял о чем речь
>1. CSS. В одном из моих отладочных чертежей вылезла следующая >ошибка (правда там объекты отрисованы в разных UCS и ужасная >мешанина из объектов):
Попробуй проверить этот чертеж _audit или _recover. Это помогло на том глючном файле, который ты присылал раньше.
>2. CSS. 3DPoly следует исключать из набора, иначе получается >следующая картина:
Пришли файл, т.к. 3dpoly исключаю
Код:
[Выделить все]
(setq line_list (vl-remove-if
                      '(lambda (x)
                         (eq "AcDb3dPolyline" (vla-get-objectname x))
                       ) ;_ end of lambda
                      line_list
                    ) ;_ end of vl-remove-if
    ) ;_ end of setq
>3. CSP. Похоже точку надо указывать точно на узле объекта?
Да
>4. Для PEDITACCEPT лучше применять конструкцию:
PEDITACCEPT появилась с 2004 Автокада. Не знаю, есть ли смысл ввводить проверку?

>5. CSS. Кроме 3DPoly, думаю следует проверять еще и линии (они >должны лежать в одной плоскости), а то получается, что грипсы >загораются на всей цепочке, но это только видимость! Если >последняя линия не в плоскости полилинии.
Здесь принцип такой: строится список объектов с совпадающими началом/концом и отдается на откуп _PEDIT _M. А уж сколь там контуров построит PEDIT одному Autodesk'у известно. Грипсами подсвечивается все, что получилось (или осталось). Это могут быть и несколько контуров, или (и) не объединенные LINE. Почему проскальзывают 3dpoly пока не понятно?

>6. На мой взгляд, fuzz по умолчанию лучше бы сделать 0.0, будем >приучать пользователей к точности.
Это правильно.

Еще терзают смутные сомнения в необходимости CSP.
VVA вне форума  
 
Автор темы   Непрочитано 19.04.2007, 11:51
#72
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> 0. Мур-мур от команд надо-бы отключить
Имеется ввиду CMDECHO?
VVA вне форума  
 
Непрочитано 20.04.2007, 04:11
#73
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA

>0. Именно CMDECHO.

>1. CSS. В одном из моих отладочных чертежей вылезла ошибка...

Audit and Recover не помогло.

>2. CSS. 3DPoly следует исключать из набора...

Если 3DPoly в конце - все OK.
А вот если в начале, то ....

>4. Для PEDITACCEPT

Отнюдь не все перешли еще на 2004>>

>5. CSS. Линии не в плоскости.

Может лучше подсветить грипсы для итоговой полилинии, а не для набора, передаваемого в PEdit?

> Еще терзают смутные сомнения в необходимости CSP.

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

И еще заметил. Если выбирать дугу, расположенную в середине цепочки, то CSS вроде логично объединяет дугу с последующими объектами (предыдущие не объединяются, предыдущий объект линия).
Но если выбрать линию (дугу) в середине цепочки, то объединяются выбранный объект и последующие и почему-то один предыдущий линия (или дуга при выборе дуги).
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 20.04.2007, 16:55
#74
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вот новый вариант
Код:
[Выделить все]
;;* Утилита объединения набора линий в полилинию*
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - точка в мировой системе координат !!!
;;    - или имя (ENAME VLA-OBJECT) начального примитива
;; fuzz - точность
;;Возвращает список vla объектов
(defun ChainSelectFromAny ( pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil))
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I") ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))) ;_ end of setq
  (progn
    (if pt (progn
      (setq ln1 (vla-addLine
            (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
                     (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))) ;_ end of and
                      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-3d-point pt)(vlax-3d-point (mapcar '- pt '(1 1 0)))))
        (setq ln ln1)))
     (setq spt (vlax-curve-getStartPoint ln)  ept (vlax-curve-getEndPoint ln))
    (setq line_list  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (cons ln chain_list)) ;_ end of setq
    (setq line_list (vl-remove-if
                      '(lambda (x)(eq "AcDb3dPolyline" (vla-get-objectname x)))
                      line_list)) ;_ end of setq
    (setq loop t cycl 0)
    (while loop
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
         (if couple (progn
             (setq chain_list (append couple chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq ln (car chain_list))) ;_ end of progn
           (setq line_list (cdr line_list))) ;_ end of if
      ) ;_ end of while
      (setq loop nil)
    ) ;_ end of while
  ) ;_ end of progn
) ;_ end of if
  (setq chain_list (vl-remove ln1 chain_list))
  (if (= (type ln1) 'VLA-OBJECT)(vl-catch-all-apply 'vla-erase (list ln1)))
  (vl-cmdf "_.redraw") chain_list)

;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
 (setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast)) nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)))
   (setvar "cmdecho" val)(princ))
;;;* returns selection set of entities since last KB:mark.
(defun mip:get-last-ss (/ ss tmp val)
(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
(if *mip:mark (progn (setq ss (ssadd))
 (while (setq *mip:mark (entnext *mip:mark))(ssadd *mip:mark ss))
 (command "._select" ss "")(setq tmp ss ss nil));_progn
 (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."));_if
 (setvar "cmdecho" val) tmp)
(defun C:CSS ( / ss pda en fuzz val)
 (vl-load-com)(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
 (if (and (setq en (car(entsel "\nВыбрать первую или последнюю линию в цепи :")))
          (wcmatch (cdr(assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
          (setq en (vlax-ename->vla-object en))
          (/= "AcDb3dPolyline" (vla-get-objectname en))
          )
 (progn
 (if (null (setq fuzz (getdist "\nЗначение допуска < 0 >: ")))(setq fuzz 0))
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss))
  (mip:mark)
  (vl-catch-all-apply '(lambda()
  (if (setq pda (getvar "PEDITACCEPT"))(progn
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz ""))))
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))(progn
      (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (setq fuzz 0)
      (while (setq en (ssname ss fuzz))
        (if (/= (cdr(assoc 0 (entget en))) "LWPOLYLINE")
          (ssdel en ss)
          (setq fuzz (1+ fuzz))))
      (sssetfirst ss ss)))
  (setq ss nil)
  )
   (princ "\nНеобходимо выбрать ОТРЕЗОК, ДУГУ, или Полилинию")
   )
(setvar "cmdecho" val)(princ)
)
(princ "\nНаберите CSS в командной строке")
VVA вне форума  
 
Непрочитано 21.04.2007, 02:21
#75
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
Может это старческое брюзжание, но:

1. Болезнь отмены работы программы так и не преодолена, для отмены нужно 2 раза посылать команду U (это касается и программ комплекса pltools).
2. Все-таки логичнее будет, если пользователь выбирает объект вблизи будущего начала полилинии и к нему добавляются только объекты, примыкающие к концу этого объекта! Сейчас же, похоже, объединение выполняется в зависимости от направления исходных объектов, причем объединение происходит в режиме: все в одном направлении + один объект в противоположном.
3. Перед началом работы программы следует сбросить грипсы. Если после CSS снова ее запускаем (грипсы на предыдущей не сброшены), то после указания нового объекта для объединения получаем ошибку:

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0 >:

Invalid option keyword.

Invalid option keyword.
; error: Function cancelled

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype
gen/Undo]:

А в целом, можно уже помещать ее в PLTolls.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 26.04.2007, 13:28
#76
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Для VVA.
Панель "Толщины полилиний" лучше назвать "Ширина новой полилинии". А в программе не мешало бы учесть "DIMSCALE".
Profan вне форума  
 
Автор темы   Непрочитано 26.04.2007, 16:21
#77
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
А в программе не мешало бы учесть "DIMSCALE"
С этого места поподробнее. На что может влиять DimScale?
VVA вне форума  
 
Непрочитано 26.04.2007, 16:34
#78
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Да вот, например. Архитекторы чертят план в масштабе 1:1, а выводить на печать будут из модели в масштабе 1:100. Все размерные величины (и тексты) соответственно увеличены в 100 раз. Для этого задается переменная "DIMSCALE" равная 100. В этих условиях ширина полилинии должна быть, для примера, не 0.5, а 50. Поэтому я и предположил, что, если "DIMSCALE" > 1, то и ширину полилинии надо устанавливать равной, скажем, 0.5 x (getvar "DIMSCALE"). Возможно, это спорный момент.
Profan вне форума  
 
Автор темы   Непрочитано 07.05.2007, 10:27
#79
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> Krieger №18
Цитата:
А как сделать реверс дуговых сегментов?
Как ни крути тип линии в одну сторону направлен.
AutoCAD2007
> Кулик Алексей aka kpblc №19
Цитата:
Это не сделать, наколько я помню, вообще никак. Только если изготовить новый тип линии и его назначать на полилинию
Может уже давно всем это известно, но для себя открыл недавно.
На дуговых сегментах полилинии тип линий может быть "вверх тормашками", причем реверс не помогает. Этот артефакт можно побороть, если в полилинии включить "генерацию типа линий".

Последний раз редактировалось VVA, 19.09.2015 в 22:56.
VVA вне форума  
 
Непрочитано 07.05.2007, 10:43
#80
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,829


Вах-вах-вах! Позор на мою дурную голову! Я этого не знал! Вай-вай-вай!
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

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

Расширенный поиск