lisp nối pline không chạm nhau

[bibach 0]

Do em chuyển file từ pdf sang cad nên các đường trục là các đường pline cho em hỏi có lisp nào chuyển các pline không chạm nhau thành 1 pline duy nhất nhưng vẫn giữ pline này không chạm nhau . Các anh xem file đính kèm của em

http://www.cadviet.com/upfiles/3/chuyen_pdf_sang_dwg.dwg

[ketxu 3004]

Bạn dùng lisp này,ệnh JP,chọn các đường pline và xác định khoảng cách lớn nhất giữa2 pline để nối chúng lại.Sau khi đã có 1 pline duy nhất rồi thì chuyển plne đó sang linetype Hidden là đúng theo ý bạn :D

;;; ======================================================  join polyline =========
(defun c:jp ( / ss plines ss2 st fuzz)
(acet-error-init
 (list (list   "cmdecho" 0
             "highlight" nil
             "plinetype" 2
              "limcheck" 0
	"osmode"  0

       );list
       0  ;use undo marks but do not roll back on a cancel
 );list
);acet-error-init

(setq plines (ssget ":l" '(
       (-4 . "         (0 . "ARC")
        (0 . "LINE")
        (-4 . "          (0 . "*POLYLINE")
         (-4 . "") ;8 16 64 not a 3dpoly or 3d/pface mesh
        (-4 . "AND>")
        (0 . "LWPOLYLINE")
       (-4 . "OR>")
                 )
             )
);setq
(if plines
    (setq plines (acet-ss-filter-current-ucs plines T))
);if
(if plines
    (setq plines (car (acet-ss-filter (list plines '(("CURRENTUCS")) T))))
);if
(princ "\n")
(if plines
    (setq ss (convert plines));setq
);if
(if (and ss
         (> (sslength ss) 0)
         plines
    );and
    (mpedit ss) ;after conversion, plines sset is duplicated in ss
    (progn
     (if (not plines)
         (princ "\nNothing selected.")
         (princ "\nNo valid objects selected.")
     );if
    );progn else
);if

(acet-error-restore)
(acet-pljoin2 ss st fuzz)
;(acet-pljoin-get-fuzz-and-mode2)
(princ)
);defun c:jp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mpedit functionality and switch cases based on kword input operation

(defun mpedit ( plines / opt newWidth ss flt fuz st na ss2 )

  (initget 0 "Open Close Join Ltype Decurve Fit Spline Width eXit _Open Close Join Ltype Decurve Fit Spline Width eXit")
  (setq opt "Join")
;   (setq opt (getkword "\nEnter an option [Open/Close/Join/Width/Fit/Spline/Decurve/Ltype gen/eXit] : "))
  ;Changed code below to a cond structure to improve readability R.K.
  (cond
   ((= opt "Join")
    (setq flt '((-4 . "                  (0 . "LINE")
                 (0 . "ARC")
                 (-4 . "                   (0 . "*POLYLINE")
                  (-4 . "") ;1 8 16 64
                 (-4 . "AND>")
                (-4 . "OR>")
               )
          flt (list flt
                    "\n1 object is invalid for join."
                    "\n%1 objects are invalid for join."
              );list
          flt (list flt
                    (list "LAYERUNLOCKED")
                    (list "CURRENTUCS")
              );list
           ss (car (acet-ss-filter (list plines flt T)))
    );setq

    (acet-autoload (list "pljoin.lsp" "(acet-pljoin-get-fuzz-and-mode)"))
    (acet-autoload (list "pljoin.lsp" "(acet-pljoin ss st fuz)"))

    (if ss
        (progn
         (setvar "highlight" 0)
         (setq fuz (acet-pljoin-get-fuzz-and-mode2)
                st (cadr fuz)
               fuz (car fuz)
                na (entlast)
         );setq
         (acet-pljoin2 ss st fuz)
         (setq ss2 (acet-ss-new na))
         (setq plines (acet-ss-union (list plines ss2)))
        );progn then
        (princ "\nNo valid objects to join.")
    );if
   );cond Join option
  );cond close
);defun mpedit

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Convert arcs and lines to polylines
;;; ss is retained as a duplicate of the plines selection set because
;;; after conversion, new handles are assigned to what were arcs and lines
(defun convert ( plines / ss count opt )
(if (> (sslength plines) 0)
    (setq opt "Yes")
;     (progn
;      (initget 0 "Yes No _Yes No")
;      (setq opt (getkword "Convert Lines and Arcs to polylines? [Yes/No] : "))
;     );progn then
);if
(if (not opt)
    (setq opt "Yes")
)
(if (and (= opt "Yes")
         (> (sslength plines) 0)
    );and
    (progn ;if yes -- convert lines and arcs to polylines
     (acet-undo-begin)
     (setq ss (ssadd))
     (setq count 0)
     (while (       (if (or (equal (assoc 0 (entget (ssname plines count))) '(0 . "ARC"))
              (equal (assoc 0 (entget (ssname plines count))) '(0 . "LINE"))
          );or
          (progn
           (command "_.pedit" (ssname plines count) "_yes" "_exit")
           (ssadd (entlast) ss)
          );progn true
          (ssadd (ssname plines count) ss)
      );if
      (setq count (1+ count))
     );while
     (acet-undo-end)
    );progn yes
    (progn ;if no -- do not convert
     (setq ss plines)
     (setq count 0)
     (while (       (if (or (equal (assoc 0 (entget (ssname ss count))) '(0 . "ARC"))
              (equal (assoc 0 (entget (ssname ss count))) '(0 . "LINE"))
          );or
          (progn
           (ssdel (ssname ss count) ss)
           (setq count (1- count))
          );progn true
      );if
      (setq count (1+ count))
     );while
    );progn no
);if
(if (and ss
         (equal (type ss) 'PICKSET)
         (equal 0 (sslength ss))
    );and
    (setq ss nil)
);if
ss
)
(if (not #acet-pljoin-prec)
   (setq #acet-pljoin-prec 0.0000001)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-pljoin2 ( ss st fuzz / flt )

(setq flt '((-4 . "             (0 . "LINE")
            (0 . "ARC")
            (-4 . "              (0 . "*POLYLINE")
             (-4 . "") ;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
(" style="vertical-align: middle;" emoid=" 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 "\ndecided not to try it.")
;(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 (:))
     (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 (:))
     (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 (:D
   (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))
             (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)
                 (              );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)
                 (:bigsmile:;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)
       (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 . "")))) ;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 "Fillet Add Both _Fillet Add Both")
 (setq st (getkword
           (acet-str-format "\nEnter join type [Fillet/Add/Both] : " #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 )
;;;;always say Both first
    (progn
     (setq #acet-pljoinmode "Both")
     (acet-setvar (list "ACET-PLJOINMODE" #acet-pljoinmode 2))
    );progn then
 (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)
;;;;;show status
 (setq st (acet-pljoin-init-mode2))
 (princ (acet-str-format "\n Join Type = %1" st))
 (if (equal "Both" st)
     (princ " (Fillet and Add) ")
 );if
;;;
  (initget "Jointype _Jointype" 4)
  (setq fuzz (getdist
               (acet-str-format "\nEnter fuzz distance or [Jointype] : " (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

[bibach 0]

Cảm ơn anh ketxu đã trả lời . Anh có thể kiểm tra lại dùm em sao em load cái lisp của anh rồi gõ lệnh jp cad báo lỗi không có lệnh này .

Cái thứ 2 cho em hỏi có cái lisp nào tạo ra đường pline mới từ 2 đường pline đó giống như block vậy , chứ làm theo cách của anh thì vừa dùng lisp vừa phải chỉnh đường nét nữa hơi lâu

[ketui 12]

Cảm ơn anh ketxu đã trả lời . Anh có thể kiểm tra lại dùm em sao em load cái lisp của anh rồi gõ lệnh jp cad báo lỗi không có lệnh này .

Cái thứ 2 cho em hỏi có cái lisp nào tạo ra đường pline mới từ 2 đường pline đó giống như block vậy , chứ làm theo cách của anh thì vừa dùng lisp vừa phải chỉnh đường nét nữa hơi lâu

Bê lây là bê lây bờ lốc là bờ lốc làm sao mà có cái đọan lai bậy này được????

[ketxu 3004]

Cảm ơn anh ketxu đã trả lời . Anh có thể kiểm tra lại dùm em sao em load cái lisp của anh rồi gõ lệnh jp cad báo lỗi không có lệnh này .

Cái thứ 2 cho em hỏi có cái lisp nào tạo ra đường pline mới từ 2 đường pline đó giống như block vậy , chứ làm theo cách của anh thì vừa dùng lisp vừa phải chỉnh đường nét nữa hơi lâu

Oh,có lẽ do mình copy code vào trong codebox,bạn down lại file này nhé

jp

 

Còn ý của bạn hỏi mình vẫn...chưa hiểu.Chỉ mất 2 thao tác thôi mà bạn vẫn nghĩ nó lâu thì mình cũng không biết mần răng :)

[bibach 0]

Oh,có lẽ do mình copy code vào trong codebox,bạn down lại file này nhé

jp

 

Còn ý của bạn hỏi mình vẫn...chưa hiểu.Chỉ mất 2 thao tác thôi mà bạn vẫn nghĩ nó lâu thì mình cũng không biết mần răng :)

Anh ketxu xem cái đường trục trong file của em đường trục bị tách rời ra thành 2 pline có cách nào nối 2 pline lại thành 1 pline nhưng không chạm nhau và giữ nguyên khoảng cách 2pline đó