Good catch.
BTW, if he converts his arcs into polylines, then he's good to go.
Hmm, where did the 'add file' button go? Oh, well, copy 'n paste.
(defun C:M3D ( / *error* @reset |acdb |e0 |i |e |ent |etyp |flag |str |layer |ans
|filter |ss |ssl$ |closed |end |bulge |sign |delta |bc |ec |chord
|chang |r |rp |arc |ang |inc |n |delete @nxtvrt @m3d |cmd |layers
|space |active |layout)
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* *
;* M3D.LSP by John F. Uhden *
;* 2 Village Road *
;* Sea Girt, NJ 08750 *
;* *
;* * * * * * * * * * * * Do not delete this heading! * * * * * * * * * * * *
; Routine converts a 2D polyline into a 3D polyline.
; v3.0 (10-18-97) added R14 LWPOLYLINE conversion; plus
; took WEED'EM filter code to alow multiple section, and
; added @cv_check_lock function.
; v4.0 (8-14-99) added capability to add vertices along curved segments
; for R13 and higher only, plus included ARCS and choice to delete
; or retain existing objects. Since given the choice, R12 can be
; treated the same way as R13+.
; Also had to do a lot of fixing of |flag values (code 70) since
; R14 gacks on (entmake)ing 3D polylines with the 128-bit set.
; v15.00 (04-07-00) for R15
; (12-17-00) added removal of entity name and handle
; (12-17-00) added multiple picks for Picklayer option
; (12-18-00) corrected |filter to use of |active and |layout
; v15.01 (09-13-02) simplified dxf removal; added removal of owner;
; added check to avoid "divide by zero" error
(gc)
(prompt "\nM3D v15.01 (c)1994-2002, John F. Uhden, Cadlantic")
(defun *error* (|err)
(@reset)
(if (wcmatch (strcase |err) "*CANCEL*,*QUIT*")
(vl-exit-with-error "\r ")
(vl-exit-with-error (strcat "\r*ERROR*: " |err))
)
)
(defun @reset ()
(if (= (type |cmd) 'INT)(setvar "cmdecho" |cmd))
(@cv_undo_end)
(princ)
)
;;-------------------------------------------
;; Initialize drawing and program variables:
;;
(if (> (getvar "cvport") 1)
(setq |space 0)
(setq |space 1)
)
(setq |cmd (getvar "cmdecho")
|active (@cv_get_activelayout) ; added 12-18-00
|layout (if (= |space 0) "Model" |active)
|filter (list (cons 0 "ARC,POLYLINE,LWPOLYLINE")(cons 410 |layout)(cons -4 "<NOT")(cons -4 "&")(cons 70 (+ 8 16 32 64))(cons -4 "NOT>"))
)
(defun @entmake (|ent / |tmp)
(setq |tmp (entmake |ent))
(if (null |tmp)
(progn
(textscr)
(prompt "\nUnable to make the following entity:\n")
(prin1 |ent)(terpri)
(exit)
)
)
)
(defun @nxtvrt (|en / |el |typ |gotit)
(setq |gotit nil |en (entnext |en))
(while (not |gotit)
(setq |el (entget |en) |typ (cdr (assoc 0 |el)))
(if (= |typ "VERTEX")
(if (= (logand 16 (cdr (assoc 70 |el))) 16) ; spline control point
(setq |en (entnext |en))
(setq |gotit 1)
)
(progn
(if |closed
(setq |en (entnext (cdr (assoc -2 |el))))
(setq |gotit 1 |en nil)
)
(setq |end 1)
)
)
)
|en
)
;;---------------------------------------------------------
;; Function boiled down to process each 2D polyline entity:
;;
(defun @m3d (|e / |e0 |ent |etyp |flag |layer |acdb |bulge |bc |ec |next
|sign |delta |chord |chang |r |rp |ang |inc |n |p)
(if (not |delete)
(progn
(command "_.copy" |e "" "0,0,0" "@")
(setq |e (entlast))
)
)
(setq |e0 |e
|ent (entget |e)
|etyp (cdr (assoc 0 |ent))
|layer (cdr (assoc 8 |ent))
)
(if (= |etyp "ARC")
(progn
(command "._PEDIT" |e0 "_Y" "")
(setq |e0 (entlast)
|e |e0
|ent (entget |e)
|etyp (cdr (assoc 0 |ent))
)
)
)
(if (= |etyp "LWPOLYLINE")
(command "_.CONVERTPOLY" "_H" |e0 "")
)
(setq |ent (entget |e)
|flag (cdr (assoc 70 |ent))
|closed (= (logand 1 |flag) 1)
|end nil
)
;; Simplified dxf removal (09-13-02)
;; Remove the entity name (-1), handle (5), and owner (330)
(setq |ent (vl-remove-if (function (lambda (x)(vl-position (car x)'(-1 5 330)))) |ent))
;; Add the 8-bit for a 3D Polyline entity
(setq |flag (boole 7 8 |flag))
;; Remove the 128-bit (plinegen) for a 3D Polyline entity
(setq |flag (boole 4 128 |flag))
(setq |ent (subst (cons 70 |flag)(assoc 70 |ent) |ent))
;; The following added for R13 (6-29-96)...
(if (vl-position (setq |acdb '(100 . "AcDb2dPolyline")) |ent)
(setq |ent (subst '(100 . "AcDb3dPolyline") |acdb |ent))
)
(entmake)
(@entmake |ent)
(while (and (not |end)(setq |e (@nxtvrt |e)))
(setq |ent (entget |e)
;; Simplified dxf removal (09-13-02)
;; Remove the entity name (-1), handle (5), and owner (330)
|ent (vl-remove-if (function (lambda (x)(vl-position (car x)'(-1 5 330)))) |ent)
|flag (cdr (assoc 70 |ent))
;; Add the 32-bit for a 3D Polyline Vertex entity
|flag (boole 7 32 |flag)
|ent (subst (cons 70 |flag)(assoc 70 |ent) |ent)
|bulge (cdr (assoc 42 |ent))
;; v3.0 "must change the bulge to zero:"
|ent (subst (cons 42 0.0)(assoc 42 |ent) |ent)
)
; The following added for R13 (6-29-96)...
(if (vl-position (setq |acdb '(100 . "AcDb2dVertex")) |ent)
(setq |ent (subst '(100 . "AcDb3dPolylineVertex") |acdb |ent))
)
(foreach n '(71 72 73 74)
(if (null (assoc n |ent))
(setq |ent (append |ent (list (cons n 0))))
)
)
(cond
((and
(/= |bulge 0.0)
(setq |next (@nxtvrt |e))
(setq |bc (cdr (assoc 10 |ent))
|ec (cdr (assoc 10 (entget |next)))
|sign (/ |bulge (abs |bulge))
|delta (* 4.0 (atan |bulge))
|chord (distance |bc |ec)
|chang (angle |bc |ec)
|r (abs (/ |chord 2.0 (sin (/ (abs |delta) 2.0))))
|arc (* |r (abs |delta))
|rp (polar |bc (+ |chang (* (- pi (abs |delta)) |sign 0.5)) |r)
|ang (angle |rp |bc)
|n (fix (/ |arc $cv_maxd))
)
(> |n 1) ;; added check to avoid "divide by zero" error
(setq |inc (/ |delta |n))
) ; and
(repeat |n
(@entmake |ent)
(setq |ang (+ |ang |inc)
|p (polar |rp |ang |r)
|ent (subst (cons 10 |p)(assoc 10 |ent) |ent)
)
)
)
(1 (@entmake |ent))
)
)
(entdel |e0)
(@entmake (list '(0 . "SEQEND")(cons 8 |layer)))
)
(@cv_undo_group)
(initget "All Layers Manually Picklayer")
(setq |ans (getkword "\nSelection method, All/Layers/Picklayer/<Manually>: "))
(cond
((= |ans "All")
(prompt "\nGetting ALL 2D ARCS and POLYLINES... ")
(setq |ss (ssget "X" |filter))
)
((= |ans "Layers")
(setq |ans (getstring "\nLayer names <*>: "))
(if (= |ans "")(setq |layer "*")(setq |layer |ans))
(prompt "\nGetting all 2D ARCS and POLYLINES on selected layer(s)... ")
(setq |ss (ssget "X" (append (list (cons 8 |layer)) |filter)))
)
((= |ans "Picklayer")
(while (setq |e (car (entsel "\nSelect object on desired layer:")))
(setq |layer (cdr (assoc 8 (entget |e)))
|layers (@cv_add_list |layer |layers)
)
(princ (strcat "\nLayers: " (@cv_list2str |layers)))
)
(if |layers
(progn
(setq |layers (@cv_list2str |layers))
(prompt (strcat "\nGetting all 2D ARCS and POLYLINES on layer(s) " |layers "... "))
(setq |ss (ssget "X" (append (list (cons 8 |layers)) |filter)))
)
)
)
(1 (prompt "\nDon't worry about selecting objects that are not 2D ARCS or POLYLINES.")
(prompt "\nThey will be filtered out of selection set.")
(setq |ss (ssget |filter))
)
)
(if (and |ss (setq |ss (@cv_check_lock |ss nil)))
(progn
(initget "Yes No")
(setq |delete (/= (getkword "\nDelete existing objects? <Yes>/No: ") "No"))
(if (or (/= (type $cv_maxd) 'REAL)(<= $cv_maxd 0.0))
(if (< (getvar "LUNITS") 3)
(setq $cv_maxd 0.5)
(setq $cv_maxd 6.0)
)
)
(initget 6)
(if (setq |ans (getdist (strcat "\nDistance to add vertices along curved segments <" (rtos $cv_maxd) ">: ")))
(setq $cv_maxd |ans)
)
(setvar "cmdecho" 0)
(prompt (strcat "\n" (itoa (sslength |ss)) " selected\n."))
(setq |i 0 |ssl$ (itoa (sslength |ss)))
(repeat (sslength |ss)
(setq |e (ssname |ss |i)
|i (1+ |i)
)
(prompt (strcat "\rProcessing # " (itoa |i) "/" |ssl$))
(@m3d |e)
)
)
)
(@reset)
)
