[编程申请]：CAD2004下的pljoin（连接线段）的lisp程序

民工

请高手编个能够在acad2004下面使用的连接线段的lisp程序
类似ET工具2000版下面的pljoin命令，像晓东工具箱里面的也可以
谢谢。

eachy

最初由 民工 发布
[B]请高手编个能够在acad2004下面使用的连接线段的lisp程序
类似ET工具2000版下面的pljoin命令，像晓东工具箱里面的也可以
谢谢。 [/B]

Pedit 的M选项还不够吗？

民工

对于我们这样的懒人来说，Pedit是很麻烦的，要输入选项，线段必须是接上的
用pljoin方便多了，晓东工具的甚至不用输入间距值，更省事。（看来老大最懒）

eachy

最初由 民工 发布
[B]对于我们这样的懒人来说，Pedit是很麻烦的，要输入选项，线段必须是接上的
用pljoin方便多了，晓东工具的甚至不用输入间距值，更省事。（看来老大最懒） [/B]

你试试Pedit-〉M-〉J 输入一个值看看结果。
关于这个M选项我做过一个演示的。

民工

最初由 eachy 发布
[B]
你试试Pedit-〉M-〉J 输入一个值看看结果。
关于这个M选项我做过一个演示的。[/B]

这个操作俺知道，以前也是这样做的
但是自从用过了pljoin和老大的工具以后，就再也不想用pedit来连接线段了，懒要懒得执著

eachy

最初由 民工 发布
[B]

这个操作俺知道，以前也是这样做的
但是自从用过了pljoin和老大的工具以后，?.. [/B]

函数库论坛好像有一个

2. 
   
3. (defun c:epljoin(/ ss)
   
4. (if (setq ss (ssget '((0 . "*line,arc"))
   
5.   (vl-cmdf ".pedit" "m" ss "" "y"  "j" "10" "")
   
6. )
   
7. )
   

<br /> (defun c:epljoin(/ ss)<br /> (if (setq ss (ssget '((0 . "*line,arc"))<br />   (vl-cmdf ".pedit" "m" ss "" "y"  "j" "10" "")<br /> )<br /> )<br />

民工

需要一个独立的lsp程序，到时候做个按钮一点就行了
楼上的程序怎么使？民工存成lsp程序加载后运行不了，显示未知命令

snsj

2. 
   
3. (defun c:epljoin(/ ss)
   
4. (if (setq ss (ssget '((0 . "*line,arc"))))
   
5.   (vl-cmdf ".pedit" "m" ss "" "y"  "j" "10" "")
   
6. )
   
7. )
   

<br /> (defun c:epljoin(/ ss)<br /> (if (setq ss (ssget '((0 . "*line,arc"))))<br />   (vl-cmdf ".pedit" "m" ss "" "y"  "j" "10" "")<br /> )<br /> )<br />

少拷贝了两个括号

dubing

不如使用AutoCAD Map的拓扑功能，生成多边形，点几下按钮，一切OK, 该连的都连了！

陌生人

".pedit" "m" ss "" "y" 用 “y” 必须选中的实体集中提取的第一个是line或arc，如果是pl线就不用写“y”
以前写过一个，适于line，arc与pl混合选集的，已经发到论坛，你找找。

民工

最初由 dubing 发布
[B]不如使用AutoCAD Map的拓扑功能，生成多边形，点几下按钮，一切OK, 该连的都连了！ [/B]

要连接的线段未必都是封闭的

用了snsj版主的，可以了，奇怪的是命令行上结束时有个“T”，怎么来的？

snsj

T的意思是程序成功了然后踢一脚，不想踢一脚的话可以在倒数第二个）后加上(princ)

民工

最初由 陌生人 发布
[B以前写过一个，适于line，arc与pl混合选集的，已经发到论坛，你找找。 [/B]

能提供链接吗？民工发这个帖子之前已经搜索过了，没什么收获，谢谢。


民工整理了一下：命令改成PJ，简单点

(defun c:pj(/ ss)
(if (setq ss (ssget '((0 . "*line,arc"))))
  (vl-cmdf ".pedit" "m" ss "" "y"  "j" "10" "")
)
(princ)
)

eachy

最初由 民工 发布
[B]

能提供链接吗？民工发这个帖子之前已经搜索过了，没什么收获，谢谢。


民工整理了一... [/B]

以前的版本过滤器没有把3dpoly过滤掉,下面这个是修改自工具箱的连接程序，2004下还可以简化

2. 
   
3. [PHP](defun l2pl (l_name / s2 n e i)
   
4.   (setq        s2 (ssget (list        '(-4 . "<AND")
   
5.                         '(0 . "LINE,*POLYLINE,ARC")
   
6.                         (cons 8 l_name)
   
7.                         '(-4 . "<NOT")
   
8.                         '(-4 . "<or")
   
9.                         '(-4 . "<AND")
   
10.                         '(0 . "*POLYLINE")
    
11.                         '(70 . 1)
    
12.                         '(-4 . "AND>")
    
13.                         '(-4 . "<and")
    
14.                         '(0 . "polyline")
    
15.                         '(100 . "acdb3dpolyline")
    
16.                         '(-4 . "and>")
    
17.                         '(-4 . "or>")
    
18.                         '(-4 . "NOT>")
    
19.                         '(-4 . "AND>")
    
20.                   )
    
21.            )
    
22.   )
    
23.   (if s2
    
24.     (progn
    
25.       (setq n (sslength s2))
    
26.       (setq i 0)
    
27.       (repeat n
    
28.         (if (setq e (ssname s2 i))
    
29.           (progn
    
30.             (if        (entget e)
    
31.               (if (wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
    
32.                 (command ".pedit" e "j" s2 "" "")
    
33.                 (command ".pedit" e "y" "j" s2 "" "")
    
34.               )
    
35.             )
    
36.             (setq i (1+ i))
    
37.           )
    
38.         )
    
39.       )
    
40.     )
    
41.   )
    
42. )
    
43. (defun C:pj        ()
    
44.   (prompt "\n请选择要连接成POLYLINE的LINE(线)和ARC(弧)<退出>:"
    
45.   )
    
46.   (l2pl "*")
    
47.   (princ)
    
48. )
    
49. [/PHP]

<br /> [PHP](defun l2pl (l_name / s2 n e i)<br />   (setq        s2 (ssget (list        '(-4 . "<AND")<br />                         '(0 . "LINE,*POLYLINE,ARC")<br />                         (cons 8 l_name)<br />                         '(-4 . "<NOT")<br />                         '(-4 . "<or")<br />                         '(-4 . "<AND")<br />                         '(0 . "*POLYLINE")<br />                         '(70 . 1)<br />                         '(-4 . "AND>")<br />                         '(-4 . "<and")<br />                         '(0 . "polyline")<br />                         '(100 . "acdb3dpolyline")<br />                         '(-4 . "and>")<br />                         '(-4 . "or>")<br />                         '(-4 . "NOT>")<br />                         '(-4 . "AND>")<br />                   )<br />            )<br />   )<br />   (if s2<br />     (progn<br />       (setq n (sslength s2))<br />       (setq i 0)<br />       (repeat n<br />         (if (setq e (ssname s2 i))<br />           (progn<br />             (if        (entget e)<br />               (if (wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")<br />                 (command ".pedit" e "j" s2 "" "")<br />                 (command ".pedit" e "y" "j" s2 "" "")<br />               )<br />             )<br />             (setq i (1+ i))<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )<br /> (defun C:pj        ()<br />   (prompt "\n请选择要连接成POLYLINE的LINE(线)和ARC(弧)<退出>:"<br />   )<br />   (l2pl "*")<br />   (princ)<br /> )<br /> [/PHP]

2004下的最佳方案

2. 
   
3. [PHP](defun c:pj (/ ss oldpe)
   
4.   (setvar "cmdecho" 0)
   
5.   (if (setq ss (ssget (list '(-4 . "<AND")
   
6.                             '(0 . "LINE,*POLYLINE,ARC")
   
7.                             '(-4 . "<NOT")
   
8.                             '(-4 . "<or")
   
9.                             '(-4 . "<AND")
   
10.                             '(0 . "*POLYLINE")
    
11.                             '(70 . 1)
    
12.                             '(-4 . "AND>")
    
13.                             '(-4 . "<and")
    
14.                             '(0 . "polyline")
    
15.                             '(100 . "acdb3dpolyline")
    
16.                             '(-4 . "and>")
    
17.                             '(-4 . "or>")
    
18.                             '(-4 . "NOT>")
    
19.                             '(-4 . "AND>")
    
20.                       )
    
21.                )
    
22.       )
    
23.     (progn
    
24.       (setq oldpe (getvar "peditaccept"))
    
25.       (setvar "peditaccept" 1)
    
26.       (vl-cmdf ".pedit" "m" ss "" "j" 10. "")
    
27.       (setvar "peditaccept" 0)
    
28.     )
    
29.   )
    
30.   (princ)
    
31. )
    
32. [/PHP]

<br /> [PHP](defun c:pj (/ ss oldpe)<br />   (setvar "cmdecho" 0)<br />   (if (setq ss (ssget (list '(-4 . "<AND")<br />                             '(0 . "LINE,*POLYLINE,ARC")<br />                             '(-4 . "<NOT")<br />                             '(-4 . "<or")<br />                             '(-4 . "<AND")<br />                             '(0 . "*POLYLINE")<br />                             '(70 . 1)<br />                             '(-4 . "AND>")<br />                             '(-4 . "<and")<br />                             '(0 . "polyline")<br />                             '(100 . "acdb3dpolyline")<br />                             '(-4 . "and>")<br />                             '(-4 . "or>")<br />                             '(-4 . "NOT>")<br />                             '(-4 . "AND>")<br />                       )<br />                )<br />       )<br />     (progn<br />       (setq oldpe (getvar "peditaccept"))<br />       (setvar "peditaccept" 1)<br />       (vl-cmdf ".pedit" "m" ss "" "j" 10. "")<br />       (setvar "peditaccept" 0)<br />     )<br />   )<br />   (princ)<br /> )<br /> [/PHP]

民工

民工在acad2004的express下面找到一个pljoinsup.lsp的程序，不知道有什么用，如何用，请高手看看：

;;;
;;;    PLJOINSUP.LSP
;;;    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.
;;;
;;;  ----------------------------------------------------------------
(if (not #acet-pljoin-prec)
    (setq #acet-pljoin-prec 0.0000001)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin2 ( ss st fuzz / flt )

(setq flt '((-4 . "<OR")
             (0 . "LINE")
             (0 . "ARC")
             (-4 . "<AND")
              (0 . "*POLYLINE")
              (-4 . "<NOT") (-4 . "&") (70 . 89)  (-4 . "NOT>") ;1 8 16 64
             (-4 . "AND>")
            (-4 . "OR>")
           )
);setq
(if (and (setq ss (acet-pljoin-do-ss-pre-work2 ss flt)) ;convert lines/arcs/heavy plines ..etc.
                                                       ;to lighweight plines
         (setq ss (acet-pljoin-1st-pass2 ss flt))       ;initial pass with pedit command
    );and
    (acet-pljoin-2nd-pass2 ss fuzz st flt) ;where the work is..
);if

);defun acet-pljoin


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Try to join as many as possible before performing the
;hashing.
;
(defun acet-pljoin-1st-pass2 ( ss flt / na )

(acet-spinner)

(setq na (entlast))
(command "_.pedit" (ssname ss 0) "_j" ss "" "_x")

(command "_.select" ss)
(if (not (equal na (entlast)))
     (command (entlast) "")
     (command "")
);if
(setq ss (acet-ss-ssget-filter ss flt));setq
(if (and ss
          (<= (sslength ss) 1)
     );and
     (setq ss nil)
);if
(setq ss (acet-pljoin-ss-flt2 ss flt))

ss
);defun acet-pljoin-1st-pass


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-2nd-pass2 ( ss fuzz st flt / g lst lst3 len x lst2 lst4 n a
                                              tmpe1 tmpe2 tmpna tmpna2 flst
                           )

;;(print "acet-pljoin-2nd-pass")
;;(print "")

;;create a couple of temporary entities for intersection checking
(setq tmpe1 (list
                '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
               '(60 . 1)
               '(62 . 1)
               '(100 . "AcDbPolyline")
               '(90 . 2) '(70 . 0) '(43 . 0.0) '(38 . 0.0) '(39 . 0.0)
               '(10 0.0 0.0) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(10 1.0 1.0)
               '(40 . 0.0) '(41 . 0.0) '(42 . 0.0)
               (cons 210 (acet-geom-cross-product (getvar "ucsxdir") (getvar "ucsydir"))) ;;(210 0.0 0.0 1.0)
              )
       tmpe2 tmpe1
);setq
(entmake tmpe1)
(setq tmpna (entlast)
       tmpe1 (entget tmpna)
);setq
(entmake tmpe2)
(setq tmpna2 (entlast)
        tmpe2 (entget tmpna2)
);setq

(if (equal fuzz 0.0)
     (setq fuzz #acet-pljoin-prec)
);if

;Pljoin checks distances between neighboring points of differing objects
;to find the closest candidates for joining. The performance problem is
;largely one of minimizing the number of distance calculations that occur.
;Here's the approach... Points are placed into a grid where each point
;is checked against other points that fall within neighboring grid points.
;This operation is similar to drawing in AutoCAD with snap turned on.
;Picked points snap to the nearest grid point.
;
;
(setq   g (* 2.01 fuzz)              ;grid size
       lst (acet-pljoin-round2 ss g)  ;round points to the grid
                                     ;lst - sub-lists (roundedpoint originalpoint 0/1 ename)
       len (length lst)
         x (/ len 8)
);setq
(if (< len 2000) ;for performance reasons if the list is greater than 2000
                  ;point the split the operation into 8 separate chunks
                  ;so they can be processed independantly.
     (setq  len 0
           lst4 lst
            lst nil
     );setq
);if

(setq n 0)
(repeat len
(setq    a (nth n lst)
       lst2 (cons a lst2)
);setq
(if (equal n (* x (/ n x)))
     (progn
       (setq lst2 (acet-pljoin-get-matched-pairs2 lst2 ;list of point data lists
                                                 lst3 ;entname map
                                                 fuzz ;fuzz distance
                                                    g ;grid size
                                                   st ;mode
                                                tmpe1 ;temp ent
                                                tmpe2 ;temp ent2
                                                 flst ;pairs that failed a join attempt
                  )
             lst3 (cadr lst2)
             flst (caddr lst2)
             lst2 (car lst2)
       );setq
       (if lst2
           (setq lst4 (append lst4 lst2)
                 lst2 nil
           );setq
       );if
     );progn then
);if
(setq n (+ n 1))
);repeat
(if lst2
     (setq lst2 (acet-pljoin-get-matched-pairs2 lst2 ;list of point data lists
                                               lst3 ;entname map
                                                fuzz ;fuzz distance
                                                  g ;grid size
                                                 st ;mode
                                              tmpe1 ;temp ent
                                              tmpe2 ;temp ent2
                                               flst ;pairs that failed a join attempt
                )
           lst3 (cadr lst2)
           flst (caddr lst2)
           lst2 (car lst2)
     );setq
);if
(if lst2
     (setq lst4 (append lst4 lst2));setq
);if
(setq  lst nil
       lst2 nil
);setq

(while lst4
  (setq  lst4 (acet-pljoin-get-matched-pairs2 lst4 ;list of point data lists
                                             lst3 ;entname map
                                              fuzz ;fuzz distance
                                                g ;grid size
                                               st ;mode
                                            tmpe1 ;temp ent
                                            tmpe2 ;temp ent2
                                             flst ;pairs that failed a join attempt
              )
         lst3 (cadr lst4)
         flst (caddr lst4)
         lst4 (car lst4)
  );setq
);while

(entdel tmpna)
(entdel tmpna2)


);defun acet-pljoin-2nd-pass

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-get-matched-pairs2 ( lst lst5 fuzz g st tmpe1 tmpe2 flst /
                                       na na2 p1 p2 n j a b c d lst2 lst3
                                       id id2 ulst x flst flag flag2 ulst2 flst2
                                       nskip
                                     )

;(print "acet-pljoin-get-matched-pairs")
;(print "")

(setq n 0)               ;;;create a list of sublist pairs in lst2 i.e. ((0 4) (2 5)...)
(repeat (length lst)     ;;;also create list of non-candidate indexs in lst3
(cond
  ((setq j (acet-pljoin-get-closest2 (nth n lst) lst fuzz g flst))
   (setq    j (list (nth n lst) j)        ;the point and it's closest candidate
         lst2 (cons j lst2)
   );setq then add this closest match pair
  );cond #1
  (T
   (setq lst3 (cons n lst3)) ;non-candidates
  );cond #2
);cond close
(if (equal n (* 20 (/ n 20)))
     (acet-spinner)
);if
(setq n (+ n 1))
);repeat

;Loop through lst2 and look for pairs that point back at each other. i.e. (p1 p2 ...) (p2 p1 ...)
;attempt the join. Track the success of the joins in ulst and the failures in flst.


(setq nskip 0)
(setq n 0)
(repeat (length lst2)
(setq     x (nth n lst2)   ;a sublist with the a point and it's 5 closest point buddies.
          id (car x)
         id2 (cadr x)
);setq

(if (and (not (member id ulst))                   ;both are points not used yet
          (not (member id2 ulst))
          (not (member (list id id2) flst))        ;have not already tried this pair and failed
          (setq b (assoc id2 lst2))
          (equal id (cadr b))                      ;closest pairs point at each other
          (setq  na (last id)                      ;get some of the data out of id and id2
                na2 (last id2)
                 p1 (cadr id)                      ;the real points
                 p2 (cadr id2)
          );setq
          (progn                                   ;get the proper entity names from the ename map lst5
           (while (setq c (assoc na lst5))   (setq na (cadr c)));while
           (while (setq c (assoc na2 lst5))  (setq na2 (cadr c)));while
           T
          );progn
          na                                       ;both entities still exist?
          na2

;          (/= 1 (logand 1 (cdr (assoc 70 (entget na)))))
;          (/= 1 (logand 1 (cdr (assoc 70 (entget na2)))))
     );and
     (progn
      ;then attempt a join
      (setq flag nil
            lst5 (acet-pljoin-do-join2 fuzz st na p1 na2 p2 lst5 tmpe1 tmpe2)
            flag (cadr lst5) ;join success?
            lst5 (car lst5)
      );setq return updated entname map and success flag
      (if flag
          (setq ulst (cons id ulst)     ;Then the join succeeded.
                ulst (cons id2 ulst)    ;mark the two as used by adding the them to ulst
          );setq the success
          (setq flst (cons (list id id2) flst)
                flst (cons (list id2 id) flst)
          );setq else join failed so mark as such in flst
      );if
     );progn then
     (progn
      (setq nskip (+ nskip 1));setq

      ;(print '(not (member id ulst)))
      ;(print (not (member id ulst)))
      ;(print '(not (member id2 ulst)))
      ;(print (not (member id2 ulst)))
      ;(print '(not (member (list id id2) flst)))
      ;(print (not (member (list id id2) flst)))
      ;(print '(setq b (assoc id2 lst2)))
      ;(print (setq b (assoc id2 lst2)))
      ;(print '(equal id (cadr b)))
      ;(print (equal id (cadr b)))
      ;(print 'na)
      ;(print na)
      ;(print 'na2)
      ;(print na2)
      ;
      ;(d-point (cadr id) "1")
      ;(d-point (cadr id2) "2")
      ;(princ "\n决定不要尝试.")
      ;(getstring "")
      ;(entdel (entlast))
      ;(entdel (entlast))

     );progn else
);if
(setq n (+ n 1))
);repeat

(if (equal nskip n)
    (setq lst nil);then all were skipped so the job is finished.
);if

(setq lst2 nil);setq ;;;remove the used and non-candidate point data from lst
(setq n 0)
(repeat (length lst)
(setq a (nth n lst));setq
(if (and (not (member n lst3))    ;not a non-candidate
          (not (member a ulst))    ;not used
     );and
     (setq lst2 (cons a lst2))
);if
(setq n (+ n 1))
);repeat

(list lst2 lst5 flst)
);defun acet-pljoin-get-matched-pairs


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-get-closest2 ( p1 lst fuzz g flst / a b c d x1 x2 x3 y1 y2 y3 n j
                                                     lst2 lst3 len2 len3 clst
                               )

;(print "acet-pljoin-get-closest")
;(print "")

(setq   b (cadr p1) ;the real point
        a (car p1)  ;the grid point
);setq

;determine the grid points to examine.
(cond
((equal fuzz 0.0 #acet-pljoin-prec)
  (setq lst2 (list (list (car a) (cadr a))
             );list
  );setq else
);cond #2
(T
  (if (<= (car a) (car b))
      (setq x1 (car a)
            x2 (acet-calc-round (+ (car a) g) g)
      );setq
      (setq x1 (acet-calc-round (- (car a) g) g)
            x2 (car a)
     );setq
  );if
  (if (<= (cadr a) (cadr b))
      (setq y1 (cadr a)
            y2 (acet-calc-round (+ (cadr a) g) g)
      );setq
      (setq y1 (acet-calc-round (- (cadr a) g) g)
            y2 (cadr a)
      );setq
  );if
  (setq lst2 (list (list x1 y1)
                   (list x2 y1)
                   (list x2 y2)
                   (list x1 y2)
             );list
  );setq
);cond #3
);cond close

(setq    d (* fuzz 2.0)
      len2 (length lst2)
);setq
;;loop through the grid points and check each of the points that fall on each grid point
(setq n 0)
(while (< n len2)
(setq lst3 (acet-list-m-assoc (nth n lst2) lst) ;get a list of assoc point based on grid point
      len3 (length lst3)
);setq

(setq j 0)
(while (< j len3)                       ;loop through the current list of grid points
                                         ;and find the closest point
  (setq a (nth j lst3))
  (if (and
           ;@rk 4:13 PM 9/7/98
           ;removed
           ;;;(not (equal (last a) (last p1)))       ;not same entity name
           ;and changed to ...
           (not (equal a p1))

           (setq c (distance (cadr p1) (cadr a))) ;distance between real original points
           (<= c fuzz)                            ;less than or equal to fuzz
           (< c d)
           (not (member (list p1 a) flst))
      );and
      (progn
       (setq    d c
             clst a
       );setq
       (if (equal c 0.0 #acet-pljoin-prec)
           (setq n len2
                 j len3
           );setq then jump out of the loop
       );if
      );progn then
  );if
(setq j (+ j 1))
);while

(setq n (+ n 1))
);while

clst
);defun acet-pljoin-get-closest


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-do-join2 ( fuzz st na p1 na2 p2 lst3 tmpe1 tmpe2 / x b e1 e2 flag closed )

(if (or (equal st "Add")
        (equal 0.0 (distance p1 p2) #acet-pljoin-prec)
        (and (setq p1 (acet-pljoin-fillet-with-fuzz2 fuzz na p1 tmpe1 na2 p2 tmpe2)
                   p2 (cadr p1)
                   p1 (car p1)
             );setq
             (equal st "Both")
        );and
        (and (equal p1 p2)
             (equal st "Fillet")
        );and
    );or
    (progn

     (setq flag T) ;then set the success flag

     (if (not (equal p1 p2)) ;;avoid the distance calc. (not (equal 0.0 (distance p1 p2)))
         (progn
          (command "_.pline" p1 p2 "")
          (command "_.pedit" na "_j" na (entlast) "" "_x")
          (if (equal 1 (logand 1 (cdr (assoc 70 (entget na)))))
              (progn
               (if (setq b (assoc na lst3))
                   (setq lst3 (subst (list na nil) b lst3));setq then subst
                   (setq lst3 (cons (list na nil) lst3));setq else add
               );if
               (setq na nil)
              );progn then
          );if
         );progn then
     );if

     (cond
      ((not na)
       na
      );cond #1
      ((and (equal na na2)
            (<= (length (acet-geom-vertex-list na)) 2);then it's a single segment polyline so don't change it
       );and
       ;then make the ename inactive by pointing it to nil in the ename map list
       (if (setq b (assoc na2 lst3))
           (setq lst3 (subst (list na2 nil) b lst3));then subst
           (setq lst3 (cons (list na2 nil) lst3));setq else add
       );if
      );cond #2
      (T
       (acet-spinner)
       (command "_.pedit" na "_j" na na2 "" "_x")
       ;The na2 is gone now so update the ename map list so that na2 points at na
       (if (setq b (assoc na2 lst3))
           (setq lst3 (subst (list na2 na) b lst3));then subst
           (setq lst3 (cons (list na2 na) lst3));setq else add
       );if
       (if (or (equal na na2)
               (equal 1 (logand 1 (cdr (assoc 70 (entget na)))))
           );or
           (progn
            ;then na is closed now so update ename map so that it points to nil.
            (if (setq b (assoc na lst3))
                (setq lst3 (subst (list na nil) b lst3));then subst
                (setq lst3 (cons (list na nil) lst3));setq else add
            );if
            (setq na nil)
           );progn then
       );if
      );cond #3
     );cond close
    );progn then add
    (progn
     ;(print '(equal 0.0 (distance p1 p2)))
     ;(print (equal 0.0 (distance p1 p2)))
     ;(print "跳过")
    );progn else
);if

(list lst3 flag) ;return the entity name map and a flag of success or failure for join.
);defun acet-pljoin-do-join


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Returns a list of sub-list of the form (roundedpoint originalpoint 0/1 ename)
;where 0 mean start point and 1 means end point of the object.
;
(defun acet-pljoin-round2 ( ss g / lst na a b c d n )

;;(princ "\n创建网格点数据...")
;;(print "acet-pljoin-round")
(setq n 0)
(repeat (sslength ss)
(setq na (ssname ss n)
       a (acet-pljoin-get-epoints2 na)
       b (cadr a)
       a (car a)
);setq
(if (and a b)
    (setq   c (list (acet-calc-round (car a) g)
                    (acet-calc-round (cadr a) g)
              );list
            d (list (acet-calc-round (car b) g)
                    (acet-calc-round (cadr b) g)
              );list
          lst (cons (list c a 0 na) lst)
          lst (cons (list d b 1 na) lst)
    );setq then
);if

(if (equal n (* (/ n 10) 10)) ;update the spinner once every ten objects
    (acet-spinner)
);if
(setq n (+ n 1));setq
);repeat
;(princ "Done.")

lst
);defun acet-pljoin-round


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-get-epoints2 ( na / e1 a b z v )

;(print "acet-pljoin-get-epoints")
;(print "")

(if (and (setq e1 (entget na))
          (setq e1 (acet-lwpline-remove-duplicate-pnts2 e1))
     );and
     (progn
      (setq z (cdr (assoc 38 e1)));setq
      (if (not z) (setq z 0.0))
      (setq v (cdr (assoc 210 e1))
            a (cdr (assoc 10 e1))
            a (list (car a) (cadr a) z)
            a (trans a v 1)
           e1 (reverse e1)
            b (cdr (assoc 10 e1))
            b (list (car b) (cadr b) z)
            b (trans b v 1)
      );setq
      (setq a (list a b))
     );progn then
);if;

;(print "done epoints")

a
);defun acet-pljoin-get-epoints

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Takes an entity list of lwpolylines and modifies the object
;removing neighboring duplicate points. If no duplicated points
;are found then the object will not be passed to (entmod ).
;Returns the new elist when done.
(defun acet-lwpline-remove-duplicate-pnts2 ( e1 / a n lst e2)

(setq n 0)
(repeat (length e1)
(setq a (nth n e1));setq
(cond
((not (equal 10 (car a)))
  (setq e2 (cons a e2))
);cond #1
((not (equal (car lst) a))
  (setq lst (cons a lst)
         e2 (cons a e2)
  );setq
);cond #2
);cond close
(setq n (+ n 1));setq
);repeat
(setq e2 (reverse e2))
(if (and e2
         (not (equal e1 e2))
         lst
    );and
    (progn
     (if (equal 1 (length lst))
         (progn
          (entdel (cdr (assoc -1 e1)))
          (setq e2 nil)
         );progn then single vertex polyline so delete it.
         (progn
          (setq e2 (subst (cons 90 (length lst)) (assoc 90 e2) e2)
          );setq
          (entmod e2)
         );progn else
     );if
    );progn then
);if

e2
);defun acet-lwpline-make-remove-duplicate-pnts

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-fillet-with-fuzz2 ( fuzz na p1 tmpe1 na2 p2 tmpe2 /
                                     e1 e2 p1a p2a lst flag flag2 n a
                                     tmpna tmpna2 x y v
                             )

;(print "acet-pljoin-fillet-with-fuzz")
;(print "")


(setq  tmpna (cdr (assoc -1 tmpe1)) ;get the temp entitiy names out of the ent lists
      tmpna2 (cdr (assoc -1 tmpe2))
         lst (acet-pljoin-mod-tmp2 na p1 tmpe1) ;make the temp ent look like the begining or ending segment
          e1 (car lst)                         ;the modified temp ent list
        flag (cadr lst)                        ;0 or 1 start or end
         p1a (caddr lst)                       ;segment info sub-list (p1 p2 bulge) where p2 is always the endpoint
         lst (acet-pljoin-mod-tmp2 na2 p2 tmpe2)
          e2 (car lst)
       flag2 (cadr lst)                          ;0 or 1 start or end
         p2a (caddr lst)                         ;segment info sub-list (p1 p2 bulge) ;in entity ucs
         lst (acet-geom-intersectwith tmpna tmpna2 3) ;get the intersection list
           v (cdr (assoc 210 e1))
         lst (acet-geom-m-trans lst 0 v) ;trans to entity coord system
);setq

(if lst
    (progn
     (setq x (acet-pljoin-get-best-int2 p1a lst))            ;get the best intersection
     (setq y (acet-pljoin-get-best-int2 p2a lst))            ;get the best intersection
     ;put the best intersections in the list x
     (cond
      ((and x y)
       (setq x (list x y))
      );cond #1
      ;;(x (setq x (list x))) ;commented because both objects must pass the best intersect test
      ;;(y (setq x (list y)))
      (T (setq x nil))
     );cond
     (if (and x
              (setq x (acet-geom-m-trans x v 1))
              (setq x (acet-pljoin-get-closest-int2 p1 p2 x))
              (<= (distance p1 x) fuzz)
              (<= (distance p2 x) fuzz)
         );and
         (progn
          (acet-pljoin-fillet-mod-epoint2 e1 flag x)
          (if (equal na na2)
              (setq e2 (entget na))
          );if
          (acet-pljoin-fillet-mod-epoint2 e2 flag2 x)
          (setq lst (list x x))
         );progn then
         (setq lst (list p1 p2))
     );if

    );progn then
    (setq lst (list p1 p2))
);if

lst
);defun acet-pljoin-fillet-with-fuzz

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;takes:
; a  - segment info sub-list (p1 p2 bulge) where p2 is always the endpoint
; lst - list of intersections
;returns the best candidate
;
(defun acet-pljoin-get-best-int2 ( a lst / p1 p2 a1 a2 n j b c d nb )

;(print "acet-pljoin-get-best-int")
;(print "")

(setq p1 (car a)   ;the iner segement
      p2 (cadr a)  ;the end point (first or last)
       b (caddr a) ;the bulge
);setq
(if (equal b 0.0)
    (setq a1 (angle p1 p2))                      ;line segment so get the angle
    (setq a1 (caddr (acet-geom-pline-arc-info p1 p2 b))) ;arc segment, so get delta angle from arc_info
);if
(setq n 0)
(repeat (length lst)
(setq a (nth n lst))
(if (equal b 0.0)
    (progn
     ;the it's a line segment
     (if (and (or (equal (angle p1 a) a1 #acet-pljoin-prec)                  (equal (abs (- (angle p1 a) a1))
                         (* 2.0 pi)
                         #acet-pljoin-prec
                  )
              );or
              (or (not d)
                  (< (setq c (distance p2 a)) d)
              );or
         );and
         (progn
          (setq d c
                j n
          );setq
         );progn then
     );if
    );progn then line segment
    (progn
     (if (equal p1 a #acet-pljoin-prec)
         (progn
          (setq a2 (* pi 2.0
                      (/ (abs a1) a1)
                   );mult
          );setq then make it 360 degrees and preserve the sign.
         );progn then
         (progn
          (setq nb (acet-pljoin-calc-new-bulge2 p1 b p2 a)
                a2 (acet-geom-pline-arc-info p1 a nb)
                a2 (caddr a2) ;delta angle
          );setq
         );progn else
     );if
     (setq c (abs (- (abs a2)
                     (abs a1)
                  )
             )
     );setq
     (if (and (>= (* a2 a1) 0.0) ;same sign delta angle
              (or (not d)
                  (< c d)
              );or
         );and
         (progn
          (setq d c
                j n
          );setq
         );progn then
     );if
    );progn else
);if
(setq n (+ n 1));setq
);repeat
(if j
    (setq d (nth j lst))
    (setq d nil)
);if

;;;for debuging only
;(d-point p1 "1")
;(d-point p2 "2")
;(if d (d-point d "3"));if
;(print 'p1)
;(print p1)
;(print 'lst)
;(print lst)
;(print d)
;(if d
;    (progn
;     (getstring "\n\nit thinks this is   COOL")
;    );progn then
;    (getstring "\n\nit thinks this   SUCKs")
;);if
;(entdel (entlast))
;(entdel (entlast))
;(if d (entdel (entlast)));if

d
);defun acet-pljoin-get-best-int

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-get-closest-int2 ( p1 p2 lst / n a j d )

(setq n 0)
(repeat (length lst)
(setq a (nth n lst)
      a (+ (distance a p1) (distance a p2))
);setq
(if (or (not d)
        (< a d)
    );or
    (setq d a
          j n
    );setq
);if
(setq n (+ n 1));setq
);repeat
(if j
    (setq a (nth j lst))
    (setq a nil)
);if

a
);defun acet-pljoin-get-closest-int



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-fillet-mod-epoint2 ( e1 flag x / p1 p2 a b e2 blg n v)

;(print "acet-pljoin-fillet-mod-epoint")
;(print "")

(setq v (cdr (assoc 210 e1))
      x (trans x 1 v)
      ;x (trans x 1 (cdr (assoc -1 e1)))
      x (list (car x) (cadr x))
);setq

(if (equal flag 1)
    (setq e1 (reverse e1))
);if
(setq n 0)
(while (and e1
            (not p2)
       );and
(setq  a (car e1)
       e1 (cdr e1)
       e2 (cons a e2)
);setq
(cond
  ((equal 10 (car a))
   (if (not p1)
       (setq p1 n)
       (setq p2 n)
   );if
  );cond #1
  ((and p1
        (equal 42 (car a))
   );and
   (setq b n)
  );cond #2
);cond close
(setq n (+ n 1))
);while
(setq e2 (reverse e2))
(if (equal 0.0 (cdr (nth b e2)))
    (setq e2 (acet-list-put-nth (cons 10 x) e2 p1));setq then line segment
    (progn
     (if (equal flag 0)
         (setq blg (acet-pljoin-calc-new-bulge2 (cdr (nth p2 e2))
                                              (* -1.0 (cdr (nth b e2)))
                                              (cdr (nth p1 e2))
                                              x
                   )
                e2 (acet-list-put-nth (cons 42 (* -1.0 blg)) e2 b)
                e2 (acet-list-put-nth (cons 10 x) e2 p1)
         );setq then
         (setq blg (acet-pljoin-calc-new-bulge2 (cdr (nth p2 e2))
                                              (cdr (nth b e2))
                                              (cdr (nth p1 e2))
                                              x
                   )
                e2 (acet-list-put-nth (cons 42 blg) e2 b)
                e2 (acet-list-put-nth (cons 10 x) e2 p1)
         );setq then
     );if
    );progn else arc segment
);if
(setq e1 (append e2 e1))
(if (equal flag 1)
    (setq e1 (reverse e1))
);if
(entmod e1)

);defun acet-pljoin-fillet-mod-epoint

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Make the temporary ent match the segment of interest to get ready to
;use the intersectwith method.
;Takes an entity name and a point that is on one end of the entity
;and a entity list of a single segment lwpolyline
;modifies the single segment polyline such that it matches the
;first or last segment (depending on the p1 provided) of the
;polyline 'na'
;
(defun acet-pljoin-mod-tmp2 ( na p1 tmpe1 / e1 e2 a b z p2 flag v )

(setq    e1 (entget na)
          v (cdr (assoc 210 e1))
         p1 (trans p1 1 v)
         p1 (list (car p1) (cadr p1))
      tmpe1 (subst (assoc 38 e1)  (assoc 38 tmpe1)  tmpe1)
      tmpe1 (subst (assoc 39 e1)  (assoc 39 tmpe1)  tmpe1)
      tmpe1 (subst (assoc 210 e1) (assoc 210 tmpe1) tmpe1)
          z (cdr (assoc 38 e1))
          a (assoc 10 e1)
);setq

(if (equal (cdr a) p1 #acet-pljoin-prec)
    (progn
     (setq  flag 0
           tmpe1 (reverse tmpe1)
           tmpe1 (subst a (assoc 10 tmpe1) tmpe1)
           tmpe1 (reverse tmpe1)
              e2 (cdr (member (assoc 10 e1) e1))
              p2 (list (car p1) (cadr p1) z)
              p1 (cdr (assoc 10 e2))
              p1 (list (car p1) (cadr p1) z)
           tmpe1 (subst (assoc 10 e2) (assoc 10 tmpe1) tmpe1)
               b (* -1.0 (cdr (assoc 42 e2)))
           tmpe1 (subst (cons 42 b)
                        (assoc 42 tmpe1)
                        tmpe1
                 )
     );setq
    );progn then
    (progn
     (setq  flag 1
              e2 (reverse e1)
           tmpe1 (reverse tmpe1)
               a (assoc 10 e2)
              p2 (cdr a)
              p2 (list (car p2) (cadr p2) z)
           tmpe1 (subst a (assoc 10 tmpe1) tmpe1)
              e2 (cdr (member a e2))
              p1 (cdr (assoc 10 e2))
              p1 (list (car p1) (cadr p1) z)
               b (cdr (assoc 42 e2))
           tmpe1 (reverse tmpe1)
           tmpe1 (subst (cons 42 b) (assoc 42 tmpe1) tmpe1)
               a (assoc 10 e2)
           tmpe1 (subst (assoc 10 e2) (assoc 10 tmpe1) tmpe1)
     );setq
    );progn else
);if

(entmod tmpe1)

(list e1 flag (list p1 p2 b))
);defun acet-pljoin-mod-tmp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Calculates the new bulge formed by moving
;point p2 to p3 and still retaining the same radius and center point.
;
(defun acet-pljoin-calc-new-bulge2 ( p1 b p2 p3 / p4 x r a c b2 info )

(setq c (distance p1 p3))
(if (not (equal c 0.0))
    (progn
     (setq   p4 (acet-geom-midpoint p1 p3)
           info (acet-geom-pline-arc-info p1 p2 b)
              r (cadr info);radius
              x (car info) ;center point
              a (- r
                   (distance x p4)
                )
     );setq
     (setq b2 (/ (* 2.0 a) c)
           b2 (* b2 (/ (abs b) b))
     );setq
     (setq info (acet-geom-pline-arc-info p1 p3 b2))
     (if (not (equal x (car info) #acet-pljoin-prec))
         (progn
          (setq a (- (* r 2.0) a));setq
          (setq b2 (/ (* 2.0 a) c)
                b2 (* b2 (/ (abs b) b))
          );setq
         );progn then
     );if
    );progn then
    (setq b2 0.0)
);if

b2
);defun acet-pljoin-calc-new-bulge


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;- explode all curve fitted and/or splined plines and re-join
;- convert all to light weight plines.
;- turn all arcs and lines into lightweight plines.
;- finally return a selection set of all plines.
(defun acet-pljoin-do-ss-pre-work2 ( ss flt / na ss2 ss3 n w)


(command "_.select" ss "")
(setq ss2 (ssget "_p" '((-4 . "&") (70 . 6)))) ;fit or splined
(command "_.select" ss "")
(setq ss3 (ssget "_p" '((-4 . "<OR") (0 . "LINE") (0 . "ARC") (-4 . "OR>")))) ;lines and arcs

(if ss2
    (progn
     (setq n 0)
     (repeat (sslength ss2)
     (setq na (ssname ss2 n)
            w (acet-pljoin-get-width2 na)
     );setq
     (command "_.explode" na)
     (while (wcmatch (getvar "cmdnames") "*EXPLODE*") (command ""))
     (command "_.pedit" (entlast) "_y" "_j" "_p" "")
     (if (not (equal w 0.0))
         (command "_w" w)
     );if
     (command "_x")
     (setq ss (ssdel na ss)
           ss (ssadd (entlast) ss)
     );setq
     (setq n (+ n 1));setq
     );repeat
    );progn then
);if
(command "_.convertpoly" "_light" ss "")
(if ss3
    (progn
     (setq n 0)
     (repeat (sslength ss3)
      (setq na (ssname ss3 n));setq
      (command "_.pedit" na "_y" "_x")
      (setq ss (ssdel na ss)
            ss (ssadd (entlast) ss)
      );setq
     (setq n (+ n 1));setq
    );repeat
   );progn then
);if
(if (equal 0 (sslength ss))
    (setq ss nil)
);if
(setq ss (acet-pljoin-ss-flt2 ss flt))


ss
);defun acet-pljoin-do-ss-pre-work


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;return the with of the heavy polyline provided in 'na'
(defun acet-pljoin-get-width2 ( na / e1 a b)

(if (and (setq e1 (entget na))
         (equal (cdr (assoc 0 e1)) "POLYLINE")
    );and
    (progn
     (setq a (cdr (assoc 40 e1))
           b (cdr (assoc 41 e1))
     );setq
     (while (and (equal a b)
                 (setq na (entnext na))
                 (setq e1 (entget na))
                 (not (equal (cdr (assoc 0 e1)) "SEQEND"))
            );and
      (setq a (cdr (assoc 40 e1))
            b (cdr (assoc 41 e1))
      );setq
     );while
    );progn then
    (setq a 0.0)
);if
a
);defun acet-pljoin-get-width

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-ss-flt2 ( ss flt / n na e1 p1 p2 )
(if (and ss
         (> (sslength ss) 0)
    );and
    (progn
     (command "_.select" ss "")
     (setq ss (ssget "_p" flt))
    );progn then
    (setq ss nil)
);if

ss
);defun acet-pljoin-ss-flt


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;prompt for a joinmode setting of "Fillet" or "Add"
(defun acet-pljoinmode2 ( / st )
  (acet-pljoin-init-mode2)
  (initget ;|PLJOIN_LSP_7|;"Fillet Add Both _Fillet Add Both")
  (setq st (getkword
            (acet-str-format ;|PLJOIN_LSP_8|;"\nEnter join type [Fillet/Add/Both] <%1>: " #acet-pljoinmode)
           );getkword
  );setq
  (if st
      (progn
       (setq #acet-pljoinmode st)
       (acet-setvar (list "ACET-PLJOINMODE" #acet-pljoinmode 2))
      );progn
  );if
);defun acet-pljoinmode

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin-init-mode2 ()
(if (not #acet-pljoinmode)
     (setq #acet-pljoinmode (acet-getvar '("ACET-PLJOINMODE" 2)))
);if
(if (not #acet-pljoinmode)
     (progn
      (setq #acet-pljoinmode "Both")
      (acet-setvar (list "ACET-PLJOINMODE" #acet-pljoinmode 2))
     );progn then
);if
#acet-pljoinmode
);defun acet-pljoin-init-mode

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;prompt for fuzz distance and/or pljoinmode setting.
;return list... (fuzz pljoinmode)
;
(defun acet-pljoin-get-fuzz-and-mode2 ( / st fuzz )
  (setq st (acet-pljoin-init-mode2))
  (princ (acet-str-format ;|PLJOIN_LSP_9|;"\n Join Type = %1" st))
  (if (equal "Both" st)
      (princ ;|PLJOIN_LSP_10|;" (Fillet and Add) ")
  );if
  (if (not #acet-pljoin-fuzz)
      (setq #acet-pljoin-fuzz 0.0)
  );if
  (if (assoc "OSMODE" (car acet:sysvar-list))
      (setvar "OSMODE" (cadr (assoc "OSMODE" (car acet:sysvar-list))))
  );if
  (setq fuzz "")
  (while (equal (type fuzz) 'STR)
   (initget ;|PLJOIN_LSP_11|;"Jointype _Jointype" 4)
   (setq fuzz (getdist
                (acet-str-format ;|PLJOIN_LSP_12|;"\nEnter fuzz distance or [Jointype] <%1>: " (rtos #acet-pljoin-fuzz))
              );getdist
   );setq
   (cond
    ((not fuzz)
     (setq fuzz #acet-pljoin-fuzz)
    );cond #1
    ((equal "Jointype" fuzz)
     (acet-pljoinmode2)
    );cond #2
    ((equal (type fuzz) 'REAL)
     (setq #acet-pljoin-fuzz fuzz)
    );cond #3
   );cond close
  );while
  (setvar "osmode" 0)

  (list #acet-pljoin-fuzz #acet-pljoinmode)
);defun acet-pljoin-get-fuzz-and-mode


(princ)