LISP to convert curves to true arcs???

LISP to convert curves to true arcs???

Jason.Rugg
Collaborator Collaborator
1,463 Views
4 Replies
Message 1 of 5

LISP to convert curves to true arcs???

Jason.Rugg
Collaborator
Collaborator

Looking for a LISP that can convert all of the curves in an entire drawing to true arcs and still look very similar to the origianl geometry. We are making a bunch of equipment tags with our plasma table and the use a stenciled style text that is getting cut out. The plasma software is not liking the curved geometry and would prefer true arcs. 

0 Likes
1,464 Views
4 Replies
Replies (4)
Message 2 of 5

doaiena
Collaborator
Collaborator

If you are talking about spline curves, you can convert them to polylines, with PLINECONVERTMODE set to 1. That will result in a polyline made of arc segments. You can then use the pline as is, or you can explode it into individual arcs.

Message 3 of 5

Kent1Cooper
Consultant
Consultant

That's pretty wide open....  There are routines around that can turn Ellipses into Polyline approximations [which can be Exploded into Arcs if necessary], or Ellipses of an axis ratio of 1 into Circles or Arcs, but if you have Splines in the mix, the conversion already mentioned can result in a whole bunch  of very short Arcs--maybe that's okay.  If you want fewer, they wouldn't all truly meet tangentially at their ends, nor be a great approximation of the shape.  For example, here's a random Spline:

Splinebase.PNG

I did something manually that a routine could probably be written to automate -- used DIVIDE to get 50 subdivision locations with POINTs [blue below], and drew Arcs [yellow] through each successive series of 3 Points.  It comes out pretty well along much of it, but note the inaccuracy and the non-tangential joints in the upper left and lower right corners of this:

ArcsOverSpline.PNG

Kent Cooper, AIA
0 Likes
Message 4 of 5

marko_ribar
Advisor
Advisor

Just an idea that is not tested in real situations, but maybe it'll work for you :

 

1. select all curves

2. explode all curves - 3d polys -> 3d lines

3. use PEDIT - "M" - multiple option reselect all curves and hit ENTER few times to exit PEDIT... All curves should become LWPOLYLINE entities

4. iterate through selection set of all LWPOLYLINE entities and change each DXF 42 Group Code to add just small bulge i.e. 0.0001 would be good enough not to destruct original shapes

5. explode all LWPOLYLINE entities with changed bulges...

All curves are ARCs now, and that's what you wanted...

 

Note that there are curve types that don't allow PEDIT - "M", like ELLIPSE for ex., you should turn them all prior all procedure to SPLINES for ex... There is my lisps for that, just search forums theswamp.org , cadtutor.net , this forum... Here is my version for converting ELLIPSES to SPLINES :

 

(defun c:el2spls ( / ce ch dxf11 dxf40 el elspl i ptst sp1 sp1cv sp1en sp1st sp2 sp2cv sp2en sp2st sp3 sp3cv sp3en sp3st sp4 sp4cv sp4en sp4st spss ss stpt enpt )
  (vl-load-com)
  (setq ss (ssget "_:L" '((0 . "ELLIPSE"))))
  (repeat (setq i (sslength ss))
    (setq el (ssname ss (setq i (1- i))))
    (vl-cmdf "_.ucs" "e" el)
    (setq ce (cdr (assoc 10 (entget el))))
    (setq dxf11 (cdr (assoc 11 (entget el))))
    (setq dxf40 (cdr (assoc 40 (entget el))))
    (setq ptst (mapcar '+ ce dxf11))
    (setq ptst (trans ptst 0 1))
    (setq ce (trans ce 0 1))
    (setq sp1st ptst)
    (setq sp1en (polar ce (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp1cv (polar sp1st (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp1 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp1st 1 0)) (cons 41 1.0) (cons 10 (trans sp1cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp1en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
    (setq sp2st sp1en)
    (setq sp2en (polar ce (angle ptst ce) (distance ptst ce)))
    (setq sp2cv (polar sp2en (+ (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp2 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp2st 1 0)) (cons 41 1.0) (cons 10 (trans sp2cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp2en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
    (setq sp3st sp2en)
    (setq sp3en (polar ce (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp3cv (polar sp3st (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp3 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp3st 1 0)) (cons 41 1.0) (cons 10 (trans sp3cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp3en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
    (setq sp4st sp3en)
    (setq sp4en sp1st)
    (setq sp4cv (polar sp4en (- (angle ptst ce) (/ PI 2.0)) (* dxf40 (distance ptst ce))))
    (setq sp4 (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline") (70 . 12) (71 . 2) (72 . 6) (73 . 3) (74 . 0) (42 . 1.0e-010) (43 . 1.0e-010) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0) (40 . 1.0)) (list (cons 10 (trans sp4st 1 0)) (cons 41 1.0) (cons 10 (trans sp4cv 1 0)) (cons 41 (/ (sqrt 2.0) 2.0)) (cons 10 (trans sp4en 1 0)) (cons 41 1.0) (assoc 210 (entget el))) )))
    (setq spss (ssadd))
    (setq stpt (vlax-curve-getstartpoint el))
    (setq enpt (vlax-curve-getendpoint el))
    (vl-cmdf "_.ucs" "w")
    (cond
      ((vlax-curve-getparamatpoint sp1 stpt)
       (ssadd sp1 spss)
       (ssadd sp2 spss)
       (ssadd sp3 spss)
       (ssadd sp4 spss)
       (vl-cmdf "_.splinedit" sp1 "j" spss "" "")
       (setq elspl (entlast))
      )
      ((vlax-curve-getparamatpoint sp2 stpt)
       (ssadd sp2 spss)
       (ssadd sp3 spss)
       (ssadd sp4 spss)
       (ssadd sp1 spss)
       (vl-cmdf "_.splinedit" sp2 "j" spss "" "")
       (setq elspl (entlast))
      )
      ((vlax-curve-getparamatpoint sp3 stpt)
       (ssadd sp3 spss)
       (ssadd sp4 spss)
       (ssadd sp1 spss)
       (ssadd sp2 spss)
       (vl-cmdf "_.splinedit" sp3 "j" spss "" "")
       (setq elspl (entlast))
      )
      ((vlax-curve-getparamatpoint sp4 stpt)
       (ssadd sp4 spss)
       (ssadd sp1 spss)
       (ssadd sp2 spss)
       (ssadd sp3 spss)
       (vl-cmdf "_.splinedit" sp4 "j" spss "" "")
       (setq elspl (entlast))
      )
    )
    (vl-cmdf "_.break" elspl stpt enpt)
    (entupd (cdr (assoc -1 (entmod (subst (assoc 8 (entget el)) (assoc 8 (entget elspl)) (entget elspl))))))
    (if (assoc 62 (entget el)) (entupd (cdr (assoc -1 (entmod (append (entget elspl) (list (assoc 62 (entget el)))))))))
    (if (assoc 420 (entget el)) (entupd (cdr (assoc -1 (entmod (append (entget elspl) (list (assoc 420 (entget el)))))))))
    (if (assoc 430 (entget el)) (entupd (cdr (assoc -1 (entmod (append (entget elspl) (list (assoc 430 (entget el)))))))))
    (entdel el)
    (vl-cmdf "_.ucs" "p")
    (vl-cmdf "_.ucs" "p")
  )
  (princ)
)

 

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 5 of 5

marko_ribar
Advisor
Advisor

Here is the code for adding small bulges to lwpolylines segments...

Untested though, but I believe it's OK...

 

(defun c:addsmallbulg2lws ( / ss i lw lwx dxf42gcodes k )
  (while
    (or
      (prompt "\nSelect LWPOLYLINE entities on unlocked layer(s) to add small bulges to their segments...")
      (not (setq ss (ssget "_:L" '((0 . "LWPOLYLINE")))))
    )
    (prompt "\nEmpty sel.set...")
    (textscr)
  )
  (repeat (setq i (sslength ss))
    (setq lw (ssname ss (setq i (1- i))))
    (setq lwx (entget lw))
    (setq dxf42gcodes (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx))
    (setq dxf42gcodes (mapcar '(lambda ( x ) (cons 42 (+ (cdr x) 0.0001))) dxf42gcodes))
    (setq lwx (mapcar '(lambda ( x ) (if (= (car x) 42) (progn (if (null k) (setq k 0) (setq k (1+ k))) (nth k dxf42gcodes)) x)) lwx))
(setq k nil) (entupd (cdr (assoc -1 (entmod lwx)))) ) (princ) )

HTH., M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes