[Irenaz]

У меня есть програмка для 2006 Автокада кторая дает возможность чертить мультилинии состоящие из полилиний. Она написана для 2006 версии Автокада не в Lisp а, насколько я понимаю, в Basic и состоит из двух файлов-DBX и ARX. Есть еще для 2008 версии. А сейчас в нашей конторе установили 2010 версию и прогромма под ней не работает, а тот програмист, который ее писал бесследно исчез. Кто-то может помочь переделать под 2010?

[Vova]

Ссылка из поста 11

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

Так оно изначально так и задумывалось...

[Vova]

А смысл?

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

Vova, ну я же предупреждал там с самого начала. Можно, конечно, переделать, но зачем? Ведь программа Profan'a работает корректно?

[-mavlin-]

И все таки мне не дает покоя первоначальная задача. Как у мультилинии сделать одну из линий толще?
Я предлагал поиграться со стилями мультилиний, но у объекта мультилиния это свойство только для чтения.
При необходимости изменить стиль мультилинии можно конечно перерисовать ее по новой, а старую удалить. В связи с этим вопрос: как программно получить доступ к стилю мультилиний?

[Vova]

Сообщение от Кулик Алексей aka kpblc Vova, ну я же предупреждал там с самого начала. Можно, конечно, переделать, но зачем? Ведь программа Profan'a работает корректно?

Программа Profan работает корректно. Просто он дал ссылку на тему, а в ней было три варианта. Естественно, я опробовал все, и увидел при этом непонятную работу твоей программы. Подумал, что дело в версии, ведь теме уже 5 лет. А оказалось, так и было задумано...

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

Сообщение от -mavlin- И все таки мне не дает покоя первоначальная задача. Как у мультилинии сделать одну из линий толще? Я предлагал поиграться со стилями мультилиний, но у объекта мультилиния это свойство только для чтения. При необходимости изменить стиль мультилинии можно конечно перерисовать ее по новой, а старую удалить. В связи с этим вопрос: как программно получить доступ к стилю мультилиний?

Может, проще будет использовать разные цвета элементов? Да и настроить соответствующим образом таблицу печати?
> Vova:

[Vova]

Нижайше прошу программистов обратить внимание на последнее предложение моего поста #19

[Profan]

Код удален за не надобностью и перемещен сюда:
http://forum.dwg.ru/showthread.php?t=30439&page=2

[-mavlin-]

Сообщение от Кулик Алексей aka kpblc Может, проще будет использовать разные цвета элементов? Да и настроить соответствующим образом таблицу печати? > Vova:

А это вариант, но есть одно но!
Мультилинии отрисованной в одном стиле нельзя присвоить другой

[Vova]

Profan, ты сделал комбинацию построения серии последовательных полилиний с округлением углов, причем все сегменты и дуги не связаны между собой. Но мне надо другое, а именно: построение серии полилиний это одна задача, и она решена в твоем начальном лиспе. А другая, самостоятельная, это соединение концов, как полилиний, так и отрезков, то есть команда Fillet, но так, чтобы полилинии не объединялись. При Filletrad=0 получается частный случай филета-Chamfer. Данная программа применялась-бы в двух случаях. 1. Для построения схем, в которых линии и полилинии соединялись бы под прямым углом без их объединяния. 2. Для построения колен труб разных диаметров. Радиусы изгиба труб известны, они разные в зависимости от диаметра трубы и технических требований к изгибу тех кабелей, что прокладываются в данной трубе.
У меня много лет работали макросы, использующие команду Exfillet из старых Express и подставленные в него переменные Filletrad для наружного и внутреннего радиуса изгиба конкретной трубы. Допустим, построил двумя отрезками(или полилиниями) горизонтальный участок 4-х дюймовой трубы, затем вертикальный. Два щелчка по внешним сторонам скругляют наружные линии большим диаметром и два щелчка по внутренним-скругляют их малым (внутренним) диаметром. После того как в автокаде при команде Fillet появилась опция М, Exfillet изъяли из набора, но эта опция объединяет полилинии, а мне это не нужно. Я загружал Exfillet во все послед. версии, но в 2010 стали происходить странности. В некоторых файлах Exfillet перестал работать. Больше того, делаю из такого файла Wblock, в нем Exfillet работает, а потом перестает. В других-же файлах все работает нормально. Выявить причину не могу.
Вот макрос для изгиба 4-дюймовой трубы, нарисованной двумя линиями:
*^C^CFilletrad;18.25;\\Fillertad;13.75;Fillet
(Здесь радиусы изгиба в дюймах). Такие-же кнопки у меня есть и для других диаметров труб, а также для труб, нарисованних одной линией.
Старый Exfillet могу выложить-может, в нем найдется ошибка.
В макросе я уже сменил Exfillet на обычный Fillet и не рисую трубы полилиниями.

[Profan]

Vova, вот твоя просьба из сообщения #19:

Теперь-бы до кучи лисп, который-бы делал множественный Fillet, не соединяя при этом полилинии в единую.....

В контексте всего того сообщения можно сделать элементарный вывод: моя программа вполне устраивает, но имеет недостаток: только линейные сегменты, хорошо бы иметь скругления без объединения в одну полилинию. Именно это я и сделал. А теперь ты пишешь совсем о другой проблеме, применительно к трубопроводам, и упоминаешь некую программу Exfillet из "старых Express". Из каких старых? В R14 Express еще вообще не было, в AutoCAD 2000, 2002, 2005, 2006, 2008 такой команды нет. Про 2004 не знаю пока, надо искать эту версию. Но сам код из сообщения #19 я изымаю за ненадобностью, тем более, что сама тема совсем не про это.
В 2004 тоже не нашел такую команду.

[VVA]

Сообщение от -mavlin- Мультилинии отрисованной в одном стиле нельзя присвоить другой

Можно.
Замена выделенных мультилиний на мультилинии другого типа

[Vova]

Сообщение от Profan упоминаешь некую программу Exfillet из "старых Express". Из каких старых? В R14 Express еще вообще не было, в AutoCAD 2000, 2002, 2005, 2006, 2008 такой команды нет. Про 2004 не знаю пока, надо искать эту версию

Вот этот код. Разве он не из Express нескольколетней давности? Надо посмотреть в экспрессовскую справку, и он должен там найтись. Вот что заметил: когда код перестает работать, сохраняю и закрываю чертеж, открываю вновь и код работает. После первой-же команды Move перестает. Copy тоже его сбивает, про другие команды не исследовал. AC 2010

Код:

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

;;
;;;
;;;    EXFILLET.LSP -- Written by Paul Vine
;;;    Copyright © 1999 by Autodesk, Inc.
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
;;;     31 strings.
;;;  ----------------------------------------------------------------
;;;     Last Revision
;;;     Credits:  Inspired by the thread "Filleting two polyline segments" on
;;;           news://adesknews.autodesk.com/autode....customization
;;;          Thanks to whomever raised the issue and participants on the thread
;;;        including particularly:
;;;        David Garrigues and Ian White
;;;    Created by Paul Vine 7/10/98
;;;    Bug fixing ... 8/6/98
;;;    Last bug fix: 9/5/98
;;;    TAHOE work (4/1/99):
;;;     Changed concatenated string usage to acet-str-format
;;;     Changes error handler calls to acet-error-init instead of bns*
;;;
;;;     FIXES THE FOLLOWING PLINE/FILLET BUGS and WISHLIST items:
;;;     1. Filleting between anything BUT a line with a  pline.
;;;         This allows the user to FILLET arcs, circles, splines, ellipses, etc., with plines
;;;         however, only lines get added to the pline    -- STILL in 2000
;;;     2. Filleting individual segments in a LWPOLYLINE more than once (this is fixed in 2000)
;;;     3. Filleting between two different plines.    (still a problem in 2000)
;;;     4. Auto-repeats command until user hits enter.
;;;     5. Eliminates looping in "Select second object:" prompt.
;;;     6. POLYLINE option using a selection set.
;;;     7. Adds a joinmode setting to automatically join objects when feasible.
 
;;;    TO DO:
;;;     19. Honor standard selection set acquisition like C, CP, WP, etc.
 ;;;    20. Allow correct undo handling of trimmode?
 
 ;;;THIS VERSION HAS THE REVISED UNDO HANDLER.
 
 
(defun c:exfillet ( / option sTrim sRad iUndo sJoin);made this guy a global
   (acet-error-init
    (list
        (list "cmdecho" 0
            "highlight" 1
              "qaflags" 0
             "limcheck" 0
            "plinetype" 2
               "clayer" (getvar "clayer")
              "cecolor" (getvar "cecolor")
              "celtype" (getvar "celtype")
	    "pickstyle" 0
        )
       0     ;flag. True means use undo for error clean up.
       '(myerror)
     );list
    );acet-error-init
 
  (sssetfirst nil nil)
  (defun myerror ()
      (if (= (type option) 'LIST)
        (redraw (car option) 4)
      )
   ) ;defun myerror
 
 
    (setvar "errno" 7)
    (setq iUndo 0) ;setq
    (while  (= (getvar "errno") 7)
      (setvar "errno" 0)
      ;;;new code follows for status line...
      (cond
        ( (= (acet-exfillet-gettrim) 0)(setq sTrim "NOTRIM"))
        ( (= (acet-exfillet-gettrim) 1)(setq sTrim "TRIM"))
        ( (= (acet-exfillet-gettrim) 2)(setq sTrim "JOIN"))
      );cond
 ;(alert (strcat "iUndo = " (itoa iUndo)))
      (setq sRad (rtos (getvar "filletrad"))) ;setq
      (princ (acet-str-format "\nCurrent settings: Mode = %1, Radius = %2" sTrim sRad))
      ;(princ (strcat "\nCurrent settings: Mode = " sTrim ", Radius = " sRad ))
      (initget "Polyline Radius Trim Undo")
      (setq option (entsel "\nSelect first object or [Polyline/Radius/Trim/Undo]: "));
      (cond
        ((= (type option) 'LIST) (acet-exfillet-optUserPick option))
        ((= option "Polyline") (acet-exfillet-optPline))
        ((= option "Radius") (acet-exfillet-optRadius))
        ((= option "Trim") (acet-exfillet-optTrim))
        ((= option "Undo") (acet-exfillet-optUndo))
      );cond
 
    );while
  (acet-error-restore)
) ;defun c:exfillet
 
(defun acet-exfillet-optUndo ()   ; (alert (itoa iUndo))
    (if (> iUndo 0)
      (progn
        ;(command "_.undo" "1")
        (command "_.undo" "_B")
        (setq iUndo (1- iUndo)) ;setq
      );progn
      (princ "\nNothing to Undo.");else if the user never started, tell 'em we're at the beginning.
    );if
    (setvar "errno" 7)
);end INTERNAL UNDO
 
 
(defun acet-exfillet-optPline ( / ss i ent)
  (setq ss (ssget '(
                    (-4 . "<OR")
                      (0 . "LWPOLYLINE")          ;filter for 2d plines
                      (-4 . "<AND")               ;or heavy plines that
                        (0 . "POLYLINE")          ;are not pface meshes
                        (-4 . "<NOT")             ;polygon meshes or
                          (-4 . "&")              ;3dpolies
                          (70 . 88)
                        (-4 . "NOT>")
                      (-4 . "AND>")
                    (-4 . "OR>")
  )))  ;setq
  (if ss
    (progn
      ;(command "_.undo" "_be")
      (command "_.undo" "_m")
      (setq i 0) ;setq
      (repeat (sslength ss)
        (setq ent (ssname ss i)) ;setq
        (command "_.fillet" "_P" ent)  ;;this failed on 3dpolies
        (setq i (1+ i)) ;setq
      ) ;repeat
      ;(command "_.undo" "_end")
      (setq iUndo (1+ iUndo)) ;setq
     );progn
   );if
   (setvar "errno" 7)
 
) ;defun optPline
 
(defun acet-exfillet-optRadius ( / ans)
  (initget 4) ; 1 line fix for negative radius.
  (setq ans (getdist (acet-str-format "\nEnter fillet radius <%1>: " (getvar "filletrad") ))) ;setq
  ;(setq ans (getdist (strcat "\nEnter fillet radius <" (rtos (getvar "filletrad"))">: " ))) ;setq
  (if ans
    (progn
    (command "_.undo" "_M")
    (setvar "filletrad" ans)
    (setq iUndo (1+ iUndo)) ;setq
    );progn
   ) ;if
   (setvar "errno" 7)
);defun
 
(defun acet-exfillet-optUserpick ( option  / lsValid lsBugfix ent entType e2 ent2  bCoplanar
                                            ent2Type ss2 entlist ent2list bLayerUnLocked pickpt1 pickpt2
                                            Color Linetype )
  (if (not iUndo)
    (setq iUndo 0) ;setq
  ) ;if
  (setq lsValid (list "POLYLINE" "LWPOLYLINE" "LINE" "ARC" "ELLIPSE" "CIRCLE" "SPLINE" "RAY" "XLINE")) ;setq
  (setq lsBugfix (list "ARC" "ELLIPSE" "CIRCLE" "SPLINE" "RAY" "XLINE" "LINE")) ;setq          ARC IS THE ONLYTHING THAT
  (setq ent (car option)) ;setq                                        ^^^^^^^ is a bug fix for filleting fit- and spline-curved plines to lines
  (setq pickpt1 (osnap (cadr option ) "_nea")) ;setq
  (redraw ent 3)
  (setq entlist (entget ent)) ;setq
  (setq entType (cdr (assoc 0 entlist)) ;setq
         bLayerUnLocked (acet-layer-locked (cdr (assoc 8 entlist))) ;setq
         bCoplanar (acet-exfillet-bCoplanar ent));
 
  (if (and (member entType lsValid) (not bLayerUnLocked) bCoplanar )     ;if the first one is good, look at the second one.
    (progn
      (setq ent2type nil) ;setq
      (setq e2 T) ;setq
      (while (and e2 (or (= (getvar "errno") 7) (not (member ent2type lsValid))) )
        (setvar "errno" 0)
        (setq e2 (entsel "\nSelect second object: ")) ;setq
        (if e2
          (progn
            (setq ent2 (car e2)) ;setq
            (setq pickpt2 (osnap (cadr e2 ) "_nea"))
            (setq ent2list (entget ent2)) ;setq
            (setq ent2Type (cdr (assoc 0 ent2list)) ;setq
                 bLayerUnLocked (acet-layer-locked (cdr (assoc 8 ent2list))) ;setq
                 bCoplanar (acet-exfillet-bCoplanar ent2))
            (if (and (member ent2Type lsValid) (not bLayerUnLocked) bCoplanar)  ;here is where the second pick is valid and we can do our thing
              (progn
                (setvar "clayer" (cdr (assoc 8 entlist)))
                (setq Color (cdr (assoc 62 entlist))) ;setq
                (setq Linetype (cdr (assoc 6 entlist))) ;setq
                (if Color
                  (setvar "cecolor" (itoa Color))
                )
                (if Linetype
                  (setvar "celtype" Linetype)
                )
                (acet-exfillet-fillet)
              );progn
        ;else  if the second object was on a locked layer or was not a valid entity.
              (progn
                (cond
                  ( bLayerUnLocked  (princ "\nThe object is on a locked layer."))
                  ( (not bCoplanar) (princ "\nObject is not parallel to the current UCS."))
                  ((not (member ent2type lsValid)) (princ "\nRequires 2 lines, arcs, circles, plines, ellipses, splines, rays or xlines."))
                  (t "\nUnknown error.")
                );cond
                (setvar "errno" 7)   ;telks the loop to ask again.
              );progn
            ) ;if
          );progn
        );if
            ;(setvar "errno" 0)    ;;;0 breaks out of the loop.
      );while
    );progn
  ;;;else the the first entity was either on a locked layer or it was an invlid object....
    (cond
        ( bLayerUnLocked  (princ "\nThe object is on a locked layer."))
        ( (not bCoplanar) (princ "\nObject is not parallel to the current UCS."))
        ((not (member enttype lsValid)) (princ "\nRequires 2 lines, arcs, circles, plines, ellipses, splines, rays or xlines."))
        (t "\nUnknown error.")
    );cond
 
  ) ;if
  (setvar "errno" 7)
  (redraw ent 4)
 
) ;defun optUserpick
 
 
 
(defun  acet-exfillet-PlinetoCurve( ent ent2 pickpt1 pickpt2 ent2Type / ss    eLast entFillet lsWidthThick subentpt1 )
  ;(print pickpt1)
  ;(command "_.undo" "_be")
  (command "_.undo" "_m")
  (setq lsWidthThick (acet-exfillet-getwidth-thickness ent))
  (command "_.explode" ent )   ;;;ent is assumed to be the pline
  (setq ss (ssget "_P")) ;setq
  (setq eLast (entlast)) ;setq
  (setq subentpt1 (car (nentselp pickpt1))) ;setq
 
  (command "_.fillet" pickpt1 pickpt2)
 
  (if (not (wcmatch (getvar "cmdnames") "*FILLET*")) ;;if we succeded in filleting
    (progn
    (cond
      ;;;if nothing new was created and we have either an arc or a line and  trim mode is set to 2.
      ( (and (equal eLast (entlast)) (or (= ent2Type "ARC") (= ent2Type "LINE")) (= (acet-exfillet-gettrim) 2))
        (progn
          ;(command "_.ucs" "_ob" subentpt1 )
          (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick))
          (command "_.pedit" ent2 "_Y" "_W" (rtos (car lsWidthThick))  "_J" ent "" "_X")   ;;;then pedit join it all together
          ;(command "_.ucs" "_P")
          (command "_.erase" ss "")
        );progn
      );this condition
 
      ;;;if something was created and trimmode is set to join
       ( (and (not (equal eLast (entlast))) (or (= ent2Type "ARC") (= ent2Type "LINE")) (= (acet-exfillet-gettrim) 2))
          (progn
            (setq entFillet (entlast))
           ; (command "_.ucs" "_ob" subentpt1 )
            (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick))
            (command "_.pedit" entFillet "_Y" "_W" (rtos (car lsWidthThick)) "_J" ent ent2 "" "_X")   ;;;then pedit join it all together
           ; (command "_.ucs" "_p" )
            (command "_.erase" ss "")
          );progn
       )
    ;;;if something was created but the second entity is not joinable...
      ( (and (not (equal eLast (entlast))) (not (or (= ent2Type "ARC") (= ent2Type "LINE"))) (= (acet-exfillet-gettrim) 2))
          (progn
            (setq entFillet (entlast))
            ;(command "_.ucs" "_ob" subentpt1 )
            (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick))
            (command "_.pedit" entFillet "_Y" "_J" ent "" "_X")   ;;;then pedit join the fillet and the pline together.
            ;(command "_.ucs" "_p")
            (command "_.erase" ss "")
          );progn
       )
 
      ( t (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick)))
    );cond
 
    ;(command "_.undo" "_end")
    (setq iUndo (1+ iUndo)) ;setq
    (setvar "errno" 0)
   );progn
  ;;else the fillet failed....
    (progn
      (command nil)  ;;;force us out of the "select second object" prompt by hitting the 1st entity again.
      ;(command "_.undo" "2");;;this might need to be changed to an undo 3
      (command "_.undo" "_B")
      (setvar "errno" 7)  ;;;errno of 7 means loop it
    );progn
  );if
 
  nil
  ;(setq e2 nil) ;setq
) ;defun ()
 
(defun acet-exfillet-fillet ( )
 
(cond
  ;;let the special casing begin....
  ((and (wcmatch entType "*POLYLINE") (member  ent2Type lsBugfix))  ;if ent1 is pline and other is on bugfix list.
    (setq e2 (acet-exfillet-PlinetoCurve ent ent2 pickpt1 pickpt2 ent2Type) )
  )
 
  ((and (wcmatch ent2Type "*POLYLINE") (member  entType lsBugfix))    ;if ent2 is pline and other is on bugfix list
    (setq e2 (acet-exfillet-PlinetoCurve ent2 ent pickpt2 pickpt1 entType))
  )
 
  ((and (= entType "LWPOLYLINE") (equal ent ent2))  ;if it's two segments on the same lwpolyline...
    (progn
 ;          (alert "2 segments on lwpoly.")
      ;(command "_.undo" "_be")
      (command "_.undo" "_m")
      (command "_.convertpoly" "_H" ent "")
      (command "_.fillet" pickpt1 pickpt2)
      (if (not (wcmatch (getvar "cmdnames") "*FILLET*")) ;;if we succeded in filleting
        (progn
          (command "_.convertpoly" "_L" ent "")
          ;(command "_.undo" "_end")
          (setq iUndo (1+ iUndo)) ;setq
          (setq e2 nil) ;setq
          (setvar "errno" 0)    ;;means we succeeded and can break out of the loop
        );progn
      ;;else
        (progn
          (command nil)  ;;;force us out of the "select second object" prompt
          ;(command "_.undo" "1")        ; changed this line
          (command "_.undo" "_B")
          (command "_.convertpoly" "_L" ent "")            ;and this line to fix P1 AutoCAD bug.
          (setvar "errno" 7)  ;;;errno of 7 means something went wrong  on the second object prompt
        );progn
      );if
    );progn
  );this case
 
  ((and (wcmatch ent2Type "*POLYLINE") (wcmatch entType "*POLYLINE")(not (equal ent ent2)))    ;if they are both plines
    (acet-exfillet-PlinetoPline)
  );this case
 
  ( T
    (progn
      (command "_.fillet" pickpt1 pickpt2)
      (if (not (wcmatch (getvar "cmdnames") "*FILLET*")) ;;if we succeded in filleting
        (progn
          (setq iUndo (1+ iUndo)) ;setq
          (setq e2 nil) ;setq
          (setvar "errno" 0)
        );progn
      ;else
        (progn
          (command nil)
          ;(command "_.undo" "1")
          (command "_.undo" "_B")
          (setvar "errno" 7)
        ) ;progn
      );if
    );progn
  );default -- just fillet 'em
);cond
 
);end defun
 
 
 
 
(defun acet-exfillet-getwidth-thickness (e /  elist rWidth this40 this41 SKIPLOOP rThickness  )
;;;Pass in the entity list for a pline and this will return a list of
;;;the widths of the various segments.   This is called by acet-exfillet-plinetopline
  (setq rWidth nil)
  (setq elist (entget e))
  (setq rThickness (cdr (assoc 39 elist))) ;setq
  (if (= rThickness nil)
    (setq rThickness 0.0) ;setq
  ) ;if
 
  (cond
    ((= (cdr(assoc 0 elist)) "LWPOLYLINE")
      (progn
      (setq rWidth (cdr (assoc 43  elist))) ;setq
      (if (= rWidth nil)
        (setq rWidth 0.0) ;setq
      ) ;if
      );progn
    )
    ((= (cdr(assoc 0 elist)) "POLYLINE")
      (progn
      (setq e (entnext e)) ;skip to the first vertex
      (setq elist (entget e))
      (setq this40 (assoc 40 elist)) ;setq
      (setq this41 (assoc 41 elist)) ;setq
      (setq rWidth (cdr this40 )) ;setq
      (if (not (= rWidth (cdr this41)))
        (progn
        (setq rWidth 0.0) ;setq
        (setq SKIPLOOP T) ;setq
        );progn
        (setq SKIPLOOP nil) ;setq
      ) ;if
      (while (and (= (cdr (assoc 0 elist)) "VERTEX") (= SKIPLOOP T))
       ;(print elist)(terpri)
        (if (or (not (= (cdr this40) rWidth)) (not (= (cdr this41) rWidth)))
          (progn
          (setq rWidth 0.0) ;setq
          (setq SKIPLOOP T) ;setq
          );progn
        ) ;if
        (setq e (entnext e))
        (setq elist (entget e))
        (setq this40 (assoc 40 elist)) ;setq
        (setq this41 (assoc 41 elist)) ;setq
      );while
      );progn
    );this cond
    (t (princ "\nMust pass a POLYLINE or LWPOLYLINE to (acet-exfillet-getwidth-thickness)."))
  );cond
  (list rWidth rThickness)
);defun
 
 
(defun acet-exfillet-optTrim ( / iTrim  sDefault ans )
 
  ;(command "_.undo" "_be")
  (command "_.undo" "_m")
  (setq iTrim (acet-exfillet-gettrim)) ;setq
 
  (cond
    ((= iTrim 0) (setq sDefault "No trim"))
    ((= iTrim 1) (setq sDefault "Trim"))
    ((= iTrim 2) (setq sDefault "Join"))
         ;setq
  ) ;if
  (initget "Join Trim Notrim")
  (setq ans (getkword (acet-str-format "\nEnter Trim mode option [Join/Trim/No trim] <%1>: " sDefault ))) ;setq
  ;(setq ans (getkword (strcat "\nEnter Trim mode option [Join/Trim/No trim] <" sDefault ">: " ))) ;setq
  (cond
    ((= ans "Join") (acet-exfillet-settrim 2))
    ((= ans "Trim") (acet-exfillet-settrim 1))
    ((= ans "Notrim") (acet-exfillet-settrim 0))
    ( t (acet-exfillet-settrim iTrim))
  );cond
  ;(command "_.undo" "_end") ;setq
  (setq iUndo (1+ iUndo)) ;setq
  (setvar "errno" 7)
) ;defun optTrim
 
 
 
(defun acet-exfillet-settrim ( iTrim / )
 
  (if (or (< iTrim 0)(> iTrim 2))
    (progn
      (princ "\nACET_TRIMMODE value must be in the range of 0 to 2.")
      nil          ;return nil if failed....
    );progn
  ;;else
    (progn
      (acet-setvar (list "ACET-TRIMMODE" iTrim 2))   ;set the bns variable in the registry
      (if (or (= iTrim 0)(= iTrim 1))       ;;if the value is 0 or 1
        (setvar "TRIMMODE" iTrim)           ;;set ACAD's the same else
        (setvar "TRIMMODE" 1)
       ;  (setvar "TRIMMODE" (getvar "TRIMMODE"))               ;; set it to 1 NO! do nothing
      ) ;if
      T   ;return true because all is well....
    );progn
  ) ;if
 
) ;defun acet-exfillet-settrim
 
(defun acet-exfillet-gettrim ( / iTrim)
 
  (setq iTrim (acet-getvar (list "ACET-TRIMMODE" 2))) ;setq
 
  (if (or
        (not iTrim)
        (and
          (or (= iTrim 0) (= iTrim 1))
          (not (= iTrim (getvar "TRIMMODE")))
        ) ;and
      );or
    ;(progn
      (setq iTrim (getvar "TRIMMODE"))
      ;(alert "\nACET-TRIMMODE and TRIMMODE were out of whack.")
      ;;;rewhack 'em
 
  ) ;if
  iTrim
) ;defun acet-exfillet-gettrim
 
(defun acet-exfillet-restorepline ( ss subentpt lsWidthThickness /    )
 ;;;Pass this function a selection set of lines and it will join them together and slap the width back on them.
  ;(command "_.ucs""_OB" subentpt)
  (command "_.pedit" subentpt "_Y" "_J" ss "" "_w")
  (if (> (car lsWidthThickness) 0.0000000)
    (command (rtos (car lsWidthThickness)) "_X")
    (command "0.0" "_X")
   );if
   (if (> (cadr lsWidthThickness) 0.00000000)
     (command "_.change" (entlast) "" "_P" "_T" (rtos (cadr lsWidthThickness))"")
   ) ;if
   ;(command "_.ucs" "_p")
  (entlast) ;return the ent name of the pline we just joined together,
);defun
 
(defun acet-exfillet-PlinetoPline  ( ;|ent ent2 pickpt1 pickpt2|; / lsWidthThick1 lsWidthThick2 eLast ss ss2 entFillet subentpt1 subentpt2 )
 
  ;    (alert "currently filleting two separate plines")
  ;(command "_.undo" "_be")
  (command "_.undo" "_m")
  (setq lsWidthThick2 (acet-exfillet-getwidth-thickness ent2) ) ;setq    Get the width info for each pline
  (command "_.explode" ent2  )                     ;explode
  (setq ss2 (ssget "_P")) ;setq                    ;stash it into a selection set
  ;;;adding new code to store width...
  (setq lsWidthThick1 (acet-exfillet-getwidth-thickness ent) ) ;setq
  (command "_.explode" ent  )
  (setq ss (ssget "_P")) ;setq
 
  (setq eLast (entlast)) ;setq
;(print pickpt1)
;(print pickpt2)
 
  (setq subentpt1 (car (nentselp pickpt1))) ;setq
  (setq subentpt2 (car (nentselp pickpt2)))
 
  (command "_.fillet" pickpt1 pickpt2);;check to see if it succeeded (no "radius too large" errors)
 
 
  (if (not (wcmatch (getvar "cmdnames") "*FILLET*")) ;;if we succeded in filleting
    (progn
      (cond
        ;;if trimmode != notrim  and there is not a new segment to add.
        ((and (equal eLast (entlast)) (not(= (acet-exfillet-gettrim) 0)))
          (progn
            ;(command "_.ucs" "_ob" subentpt1 )
            (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick1))
            (setq ent2 (acet-exfillet-restorepline ss2 subentpt2 lsWidthThick2))
            (if (= (acet-exfillet-gettrim) 2)
              (command "_.pedit" ent  "_J" ent ent2 "" "_X")
            );if
            ;(command "_.ucs" "_p"  )
            (command "_.erase" ss ss2 "")
          );progn
        )
    ;;if trimmode != notrim and there is a new segment to add...
        ((and (not (equal eLast (entlast))) (not(= (acet-exfillet-gettrim) 0)))
          (progn
            (setq entFillet (entlast)) ;setq
            (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick1))
            (setq ent2 (acet-exfillet-restorepline ss2 subentpt2 lsWidthThick2))
            (if (= (acet-exfillet-gettrim)  2)
              (command "_.pedit" entFillet "_Y" "_W" (rtos (car lsWidthThick1)) "_J" ent ent2  "" "_X") ;apply width to fillet segment.
            );if
            (command "_.erase" ss ss2 "")
          );progn
        )
 
        (T
          (progn
            (setq ent (acet-exfillet-restorepline ss subentpt1 lsWidthThick1))
            (setq ent2 (acet-exfillet-restorepline ss2 subentpt2 lsWidthThick2))
          );progn
        )
 
      ) ;cond
 
      ;(command "_.undo" "_end")
      (setq iUndo (1+ iUndo)) ;setq
      (setq e2 nil) ;setq
      (setvar "errno" 0)
    );progn
  ;else
    (progn
      (command nil)  ;;;force us out of the "select second object" prompt
      ;(command "_.undo" "3")
      (command "_.undo" "_b")
      (setvar "errno" 7)  ;;;errno of 7 means something went wrong
    );progn
  );if
 
) ;defun acet-exfillet-PlinetoPline
 
(defun acet-Exfillet-bCoplanar ( e / elist v_ent v_ucs )
  ;;;takes an entity name and returns true if it lies in the plane of the current UCS.
  (setq elist (entget e)
       v_ent (cdr (assoc 210 elist))
      v_ucs (acet-geom-cross-product (getvar "ucsxdir") (getvar "ucsydir"))
  );setq
 
  (equal v_ent v_ucs 0.00000001)    ; return T if the entity is coplanar and nil if it is not.
 
) ;defun acet-exfillet-b-coplanar


(princ)

[RFL]

Прошу прощенья за то, что вклинился, но дабы не создавть новую тему, изложу свою просьбу здесь. Суть - заточить под 2010 вот эту вещицу - http://dwg.ru/dnl/4357. К сожаленью с автором связаться не удается.

[Profan]

Для Vova.
В свое время выпускались отдельно какие-то сборники Express Tools. Я пока не наткнулся на этот файл.

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

RFL, это нереально. Лиспы вроде были, позволяющие выполнять рисование на основе образца - достаточно поискать (здесь и на caduser.ru)
Vova, поверхностный анализ кода привел вот к чему: там безумное количество командных методов. Команды имеют тенденцию меняться от версии к версии. И, учитывая, что pedit там используется "в полный рост", я бы задумывался о проверке значений peditaccept. Короче, код по идее надо переделывать, но я на это сейчас уже не способен.

[Nike]

RFL
QUICKDRAW - рисование по примитиву-образцу, аналог той вещицы

[Vova]

Сообщение от Кулик Алексей aka kpblc И, учитывая, что pedit там используется "в полный рост", я бы задумывался о проверке значений peditaccept.

Peditaccept в файле я менял, это не повлияло на неработоспособность. Да и во всех пред. версиях работало, кроме 2010

[Profan]

Значит так, Vova. В стандартных поставках AutoCAD (включая 2000) в ET команда (и файл) EXFILLET отсутствует. Я нашел ее в отдельном сборнике (как я и предполагал) "Express Tools volume 1-9". Пришлось мне установить AutoCAD 2000 без штатного ET и потом уже установить Express Tools из этого сборника. Поработал я с этой командой и вот что отмечу: если начерчены последовательные разрозненные сегменты полилиний, то их можно сопрячь или без объединения (TRIM), или с объединением (JOIN). В первом случае сопряжение производится дугой, во втором случае дуговым сегментом полилинии. Я теперь понял, что тебе нужно. В этой программе можно дополнительно менять радиус сопряжения в процессе выполнения команды. Только вот что не совсем то, на мой взгляд. Ты ведь задаешь нужную ширину полилинии, а сопряжение у тебя без объединения выполняется дугой, у которой никакой ширины нет (если не задан вес). Как же ты выходил из положения?
Я проверил работу этой программы в разных версиях AutoCAD. Действительно, она работает везде, кроме 2010. Не знаю, смогу ли разобраться...

Дальше. Вот, что я пока заметил. Эта программа расчленяет полилинии, сопрягает их и опять превращает в полилинии. Однако, дуговой сегмент, если не задано объединение, так и остается дугой, а не дуговым сегментом полилинии.
Vova, я в "Готовых программах" выложил свой вариант аналога этой программы. Моя программа еще достаточно простая, без разветвления и циклов. Но в ней дуга сопряжения преобразуется в дуговой сегмент полилинии.
http://forum.dwg.ru/showthread.php?p=518427#post518427