pljoin (Autodesk/Rund um AutoCAD)

;;;
;;; PLJOIN.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.
;;;
;;; ----------------------------------------------------------------

;Set global for controling precision of internal point comparison.
(setq #acet-pljoin-prec 0.0000001)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c :pljoin ( / flt ss fuzz st )

(acet-error-init
(list (list "cmdecho" 0
"highlight" (getvar "highlight")
"plinetype" 2
"limcheck" 0
"osmode" 0
)
0
'(progn ;clean up some temporary entities
(if (and tmpna
(entget tmpna)
);and
(entdel tmpna)
);if
(if (and tmpna2
(entget tmpna2)
);and
(entdel tmpna2)
);if
);progn
);list
);acet-error-init
(setq flt (list
(list '((-4 . "<OR") (0 . "LINE") (0 . "ARC") (0 . "*POLYLINE") (-4 . "OR>"))
"\n1 object was not a line, arc or pline."
"\n%1 objects were not lines, arcs or plines."
);list
(list '((-4 . "<OR") (0 . "LINE") (0 . "ARC")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>") ;1
(-4 . "AND>")
(-4 . "OR>"))
"\n1 object was a closed pline."
"\n%1 objects were closed plines."
);list
(list '((-4 . "<OR") (0 . "LINE") (0 . "ARC")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "<NOT") (-4 . "&") (70 . 88) (-4 . "NOT>") ;8 16 64
(-4 . "AND>")
(-4 . "OR>"))
"\n1 object was a mesh or 3dpoly."
"\n%1 objects were 3d plines or meshes."
);list
(list "LAYERUNLOCKED")
(list "CURRENTUCS")
);list
);setq

(if (and (setq ss (ssget))
(setq ss (acet-ss-filter-current-ucs ss T))
(setq ss (car (acet-ss-filter (list ss flt T))))
);and
(progn
(setvar "highlight" 0)
(setq fuzz (acet-pljoin-get-fuzz-and-mode2)
st (cadr fuzz)
fuzz (car fuzz)
);setq
(princ "\nProcessing pline data....")
(acet-pljoin2 ss st fuzz)
(princ (acet-str-format "%1 Done.\n" (chr 8)))
);progn then
(princ "\nNothing valid selected.")
);if
(acet-error-restore)
);defun c :pljoin

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c :pljoinmode ( / )
(acet-error-init nil)
(acet-pljoinmode2)
(acet-error-restore)
);defun c :pljoinmode

;;;backward compatibility stub functions....
(defun acet-pljoin ( ss st fuzz)
(acet-pljoin2 ss st fuzz)
)
(defun acet-pljoin-1st-pass ( ss flt)
(acet-pljoin-1st-pass2 ss flt)
)
(defun acet-pljoin-2nd-pass ( ss fuzz st flt)
(acet-pljoin-2nd-pass2 ss fuzz st flt)
)
(defun acet-pljoin-get-matched-pairs ( lst lst5 fuzz g st tmpe1 tmpe2 flst)
(acet-pljoin-get-matched-pairs2 lst lst5 fuzz g st tmpe1 tmpe2 flst)
)
(defun acet-pljoin-get-closest ( p1 lst fuzz g flst)
(acet-pljoin-get-closest2 p1 lst fuzz g flst)
)
(defun acet-pljoin-do-join ( fuzz st na p1 na2 p2 lst3 tmpe1 tmpe2)
(acet-pljoin-do-join2 fuzz st na p1 na2 p2 lst3 tmpe1 tmpe2)
)
(defun acet-pljoin-round ( ss g)
(acet-pljoin-round2 ss g)
)
(defun acet-pljoin-get-epoints ( na)
(acet-pljoin-get-epoints2 na)
)
(defun acet-lwpline-remove-duplicate-pnts ( e1)
(acet-lwpline-remove-duplicate-pnts2 e1)
)
(defun acet-pljoin-fillet-with-fuzz ( fuzz na p1 tmpe1 na2 p2 tmpe2)
(acet-pljoin-fillet-with-fuzz2 fuzz na p1 tmpe1 na2 p2 tmpe2)
)
(defun acet-pljoin-get-best-int ( a lst)
(acet-pljoin-get-best-int2 a lst)
)
(defun acet-pljoin-get-closest-int ( p1 p2 lst)
(acet-pljoin-get-closest-int2 p1 p2 lst)
)
(defun acet-pljoin-fillet-mod-epoint ( e1 flag x)
(acet-pljoin-fillet-mod-epoint2 e1 flag x)
)
(defun acet-pljoin-mod-tmp ( na p1 tmpe1)
(acet-pljoin-mod-tmp2 na p1 tmpe1)
)
(defun acet-pljoin-calc-new-bulge ( p1 b p2 p3)
(acet-pljoin-calc-new-bulge2 p1 b p2 p3)
)
(defun acet-pljoin-do-ss-pre-work ( ss flt)
(acet-pljoin-do-ss-pre-work2 ss flt)
)
(defun acet-pljoin-get-width ( na)
(acet-pljoin-get-width2 na)
)
(defun acet-pljoin-ss-flt ( ss flt)
(acet-pljoin-ss-flt2 ss flt)
)
(defun acet-pljoinmode ()
(acet-pljoinmode2)
)
(defun acet-pljoin-init-mode ()
(acet-pljoin-init-mode2)
)
(defun acet-pljoin-get-fuzz-and-mode ()
(acet-pljoin-get-fuzz-and-mode2)
)

(acet-autoload2 '("PLJOINSUP.LSP" (acet-lwpline-remove-duplicate-pnts2 e1)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-1st-pass2 ss flt)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin2 ss st fuzz)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-2nd-pass2 ss fuzz st flt)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-calc-new-bulge2 p1 b p2 p3)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-do-join2 fuzz st na p1 na2 p2 lst3 tmpe1 tmpe2)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-do-ss-pre-work2 ss flt)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-fillet-mod-epoint2 e1 flag x)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-fillet-with-fuzz2 fuzz na p1 tmpe1 na2 p2 tmpe2)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-best-int2 a lst)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-closest2 p1 lst fuzz g flst)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-closest-int2 p1 p2 lst)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-epoints2 na)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-fuzz-and-mode2)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-matched-pairs2 lst lst5 fuzz g st tmpe1 tmpe2 flst)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-get-width2 na)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-init-mode2)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoinmode2)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-mod-tmp2 na p1 tmpe1)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-round2 ss g)))
(acet-autoload2 '("PLJOINSUP.LSP" (acet-pljoin-ss-flt2 ss flt)))
(princ)

------------------
"Stellt Euch vor, es geht, und keiner kriegt's hin." (Neuss)

[Diese Nachricht wurde von Kramer24 am 16. Jan. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP