[Irenaz]

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

[Vova]

Сообщение от Profan Ты ведь задаешь нужную ширину полилинии, а сопряжение у тебя без объединения выполняется дугой, у которой никакой ширины нет (если не задан вес). Как же ты выходил из положения?

Дело в том, что я пользовался программой для схем, и там все углы прямые и радиус = 0. Там где надо гнуть трубы я всегда рисовал отрезками, поэтому проблем не возникало. Почему схемы и трубы всегда либо отрезками, либо разрозненными полилиниями? Потому что в таких чертежах к конечному результату подходишь постепенно, по сто раз перерисовывая. Какие уж тут объединенные полилинии?
По твоей программе ответ в соотв. теме

[Profan]

Vova - вот несложная программа, могущая в какой-то мере заменить программу из ET. Команда UNDO работает после завершения работы программы.

Код:

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

 
;********** EXTFILLET.LSP *****************************************
; The program of interface of separate segments of polylines or pieces
; with the subsequent transformation to separate segments of polylines.
; If pieces the width of resultants of polylines is equal to zero are interfaced.
; If one of interfaced objects - a polyline, polyline resultants
; get width of the initial polyline specified second.
; Author Gromov Vladimir aka Profan 2010
;
; A macro for loading:
; ^C^C(if (not C:EXTFILLET (load "extfillet")) EXTFILLET
;
(defun C:EXTFILLET ( / echo flag rd ent1 ent2 widp)
(vl-load-com)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq flag T)
(while flag
(if (not ido) (setq ido "plin"))
(if (= ido "lin") (princ " LINE. ")) (if (= ido "plin") (princ "POLYLINE. "))
(princ (strcat "Current FILLETRAD = " (rtos (getvar "FILLETRAD"))))
(initget "Radius LLine Polyline")
(setq ent1  (entsel "\n Select first object or [Radius/LLine/Polyline] (Enter-Exit): "))
     (if (= ent1 "Radius")
         (progn
         (if (null rds) (setq rds "0"))
         (princ (strcat "\n Enter fillet radius <" rds "> : "))
         (setq rd (getreal))
         (if (= rd nil) (setq rd (atof rds)) (setq rds (rtos rd)))
         (vl-cmdf "_FILLET" "_r" rd)
         ) ; progn
         (progn
         (if (= ent1 nil) (setq flag nil))
         (cond
         ((= ent1 "LLine") (setq ido "lin"))
         ((= ent1 "Polyline") (setq ido "plin"))
         )
         (if (= (type ent1) 'LIST)
             (progn
             (setq ent1 (car ent1))
             (redraw ent1 3)
             (setq ent2 (car (entsel "\n Select second object: ")))
             (princ "\n")
             (if(eq ent1 ent2) 
                (progn
                (redraw ent1 4) (princ "\nERROR! It's two segments on the same line. ")
         ) ; progn
         (progn
                (vl-cmdf "_UNDO" "_BE")
                (if (and ent1 ent2 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE"))
                    (progn
                    (setq widp  (cdr (assoc 43 (entget ent1))))
                    (vla-explode (vlax-ename->vla-object ent1))
                    (vl-cmdf "_erase" ent1 "")  
                    (setq ent1 (entlast))                                                              
                    ) ; progn
                ) ; if
                (if (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE"))
                    (progn
                    (setq widp  (cdr (assoc 43 (entget ent2))))
                    (vla-explode (vlax-ename->vla-object ent2))
                    (vl-cmdf "_erase" ent2 "")
                    (setq ent2 (entlast))
                    ) ; progn
                ) ; if
                (if (and ent1 ent2)
                    (progn
                    (if (= widp nil) (setq widp 0))
                    (if (or (= ido "lin") (= ido "plin")) (vl-cmdf "_fillet" ent1 ent2))
                    (redraw ent1 4)
                    (if (= ido "plin")
                        (progn
                        (cond
                        ((= (getvar "PEDITACCEPT") 0) (vl-cmdf "_pedit" "_M" "_L" ent1 ent2 "" "_Y" "_W" widp ""))
                        ((= (getvar "PEDITACCEPT") 1) (vl-cmdf "_pedit" "_M" "_L" ent1 ent2 "" "_W" widp  ""))
                        ) ; cond
                    )) ; progn if
                    (vl-cmdf "_UNDO" "_E")
                    ) ; progn
                    (progn
                    (redraw ent1 4)
                    (princ "\n No selected object.")
                    ) ; progn
                ) ; if
             )) ; progn if
         )) ; progn if
     )) ; progn if
) ;  while
(setvar "CMDECHO" echo)
(princ)
)
(princ "\n Enter in command line EXTFILLET")

Добавлено.
Vova, для корректной работы программы пришлось поменять Line в запросе на LLine.

[Profan]

Специально для Vova написал сообщение, чтобы он взял исправленный код в предыдущем сообщении - так нет, ликвидировали его.

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

Profan, тебе же русским языком сказано было: обращайся в ЛС. Или ты почту не смотришь принципиально?

[Vova]

Не понял, что произошло, но пока суть да дело посылаю файл для тренировки программы на Draworder. Слева две верикальные и две горизонтальные линии фрагмента схемы. Одна пара выполнена полилиниями, другая линиями. На обеих вертикальных сидит по блоку с масками. Далее в процессе редактирования схемы понадобилось сместить горизонтальные участки, как показано справа. Надо соединить опять вертикальные с горизонтальными программой Extfillet. У меня при этом толстая полилиния поднимается наверх и перекрывает блок. Тонкие отрезки превращаются в тонкие-же полилинии, оставаясь при этом под блоком. Но поскольку они теперь полилинии, то при повторном применении к ним Extfillet (допустим, опять понадобилось что-тосместить) вылезут наверх. При старой команде из Express (Exfillet) такого не происходило.

[Profan]

Сообщение от Кулик Алексей aka kpblc Profan, тебе же русским языком сказано было: обращайся в ЛС. Или ты почту не смотришь принципиально?

Да, почту с форума я стираю не глядя, поскольку считаю ее предвзятой.
Vova, дальше с этой программой я работать не буду, гори она синим пламенем.

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

Сообщение от Profan Да, почту с форума я стираю не глядя, поскольку считаю ее предвзятой.

Поздравляю.

Сообщение от Profan Vova, дальше с этой программой я работать не буду, гори она синим пламенем.

Еще раз поздравляю.
Тебе не кажется, что такие шаги немного глупо выглядят?

[Do$]

Сообщение от Vova Не понял, что произошло, но пока суть да дело посылаю файл для тренировки программы на Draworder. Слева две верикальные и две горизонтальные линии фрагмента схемы. Одна пара выполнена полилиниями, другая линиями. На обеих вертикальных сидит по блоку с масками. Далее в процессе редактирования схемы понадобилось сместить горизонтальные участки, как показано справа. Надо соединить опять вертикальные с горизонтальными программой Extfillet. У меня при этом толстая полилиния поднимается наверх и перекрывает блок. Тонкие отрезки превращаются в тонкие-же полилинии, оставаясь при этом под блоком. Но поскольку они теперь полилинии, то при повторном применении к ним Extfillet (допустим, опять понадобилось что-тосместить) вылезут наверх. При старой команде из Express (Exfillet) такого не происходило.

К сожалению, нет у меня 2010 версии, не могу чертеж посмотреть и опробовать. Но когда писал эту програмку, на что-то похожее (судя по описанию) натыкался. Дело может быть в том, что если примитив - объект "LINE", то в команду "fillet" нужно передавать просто ENAME, а если имеем дело с полилинией, то передавать в "fillet" нужно список в таком виде, как его возвращет функция ENTSEL: (ENAME (X Y Z)).

[Vova]

Сообщение от Do$ К сожалению, нет у меня 2010 версии, не могу чертеж посмотреть и опробовать.

Пересохранил как 2004

[VVA]

Vova, Я за изменениями программы Exfillet не следил. Кое-что подправил в оригинальной. Должна работать в 2010.

Код:

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

;;
;;;    adaptation for AutoCAD 2010 VVA (V.A.Azarko)
;;;    posted http://forum.dwg.ru/showthread.php?t=47047&page=3
;;;
;;;    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" (list ent pickpt1)(list ent2 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"  (list ent pickpt1)(list ent2 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"  (list subentpt1 pickpt1)(list subentpt2 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)

Непонятно, почему стабильно работало в прежних версиях. заменил строчку
(command "_.fillet" pickpt1 pickpt2)
строчкой
(command "_.fillet" (list ent pickpt1)(list ent2 pickpt2)) для отрезков.
В общем то, о чем говорил Do$ в #48. Только у меня получилось так

Дело может быть в том, что если примитив - объект "LINE", то в команду "fillet" нужно передавать нужно список в таком виде, как его возвращет функция ENTSEL: (ENAME (X Y Z)), а если имеем дело с полилинией, то передавать в "fillet" просто точки (оставил как в старой версии)

[Vova]

После вмешательства VVA старая программа Exfillet из Express обрела вторую жизнь. Она соединяет отрезки или полилинии в fillet с выбранным радиусом, в том числе равным нулю, то есть превращается в Chamfer, не соединяя полилинии в единую и делая пары соединений без перерыва.
Напоминаю историю команды, Раньше у автокада команды Fillet и Chamfer не имели опции Multiple, и Exfillet восполняла этот пробел. Затем опция М появилась, и из Express убрали Exfillet. Но с новой опцией полилинии соединялись в единую, что меня не устраивало. Я продолжал использовать Exfillet, перетаскивая его из версии в версию. Но в 2010 команда перестала работать. И вот VVA нашел ошибку. Спасибище ему огромное.
Также благодарю Profan, хотя он и не довел до конца свою работу. А могло получиться неплохо и короче. В паре с его программой, которая чертит полилинии, не соединяя сегменты получилась законченная комбинация для вычерчивания, например, схем. И Do$ внес свою лепту в разрешение проблемы
Это уже четвертая программа из Express, которую исправил VVA. Я могу гордиться что три из них родились с моим участием.
Можно добавить Exfillet сюда

[Profan]

Значит, так. Подчеркну, что в стандартной поставке AutoCAD программы exfillet никогда не было, эта программа была в отдельном самостоятельном сборнике, который можно было установить автономно на AutoCAD 2000, 2000i и 2002. Поэтому она никогда и не убиралась из Express Tools. Сам я считаю именно эту программу недоделанной, поскольку линейные сегменты полилиний сопрягаются обычной дугой, а не дуговым сегментом полилинии. Необходимо отметить еще, что fillet (сопряжение) и chamfer (фаска) - разные команды и установка радиуса сопряжения в 0 не превращает fillet в chamfer.

[Vova]

Сообщение от Profan разные команды и установка радиуса сопряжения в 0 не превращает fillet в chamfer.

Да, ты прав. Фаски длиной больше нуля не сделать. Я допустил неточность