- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi
Is the a LISP routine out there to changing this special holes to normal circle by itself.
I have a lot of them
Regards
Henrik
Solved! Go to Solution.
Link copied
Hi
Is the a LISP routine out there to changing this special holes to normal circle by itself.
I have a lot of them
Regards
Henrik
Solved! Go to Solution.
Hi,
Here's a 'quick and dirty':
(defun c:SPL2CRCL (/ ss i)
(if (setq
ss (ssget
'((0 . "SPLINE") (-4 . "&") (70 . 13) (71 . 2) (73 . 9))
)
)
(repeat (setq i (sslength ss))
(Spline2Circle (ssname ss (setq i (1- i))))
)
)
(princ)
)
(defun midPoint (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)
)
(defun Spline2Circle (spl / p0 p4 c r)
(setq
p0 (getpropertyvalue spl "ControlPoints" 0 "Position")
p4 (getpropertyvalue spl "ControlPoints" 4 "Position")
c (midPoint p0 p4)
r (distance c p0)
)
(entdel spl)
(entmakex
(list
(cons 0 "CIRCLE")
(cons 10 c)
(cons 40 r)
)
)
)
Found this TT code by doing a search on-line for "autolisp spline to circle" and it works on your posted sample drawing.
Hi _Gile
It works, simply fantastic, tangs for helping me out, thangs
Have a nice weekend
Regards
Henrik
Hi paullimapa
It works too, fantastic, tangs for helping me out, thangs
Have a nice weekend
Regards
Henrik
You’re welcome and cheers!!!
Another way [in simplest terms]:
(defun C:S2C (/ ss n spl LL UR)
(if (setq ss (ssget '((0 . "SPLINE"))))
(repeat (setq n (sslength ss))
(setq spl (ssname ss (setq n (1- n))))
(vla-getboundingbox (vlax-ename->vla-object spl) 'minpt 'maxpt)
(setq
LL (vlax-safearray->list minpt)
UR (vlax-safearray->list maxpt)
)
(command
"_.circle" "_non" (mapcar '/ (mapcar '+ LL UR) '(2 2 2)) (/ (- (car UR) (car LL)) 2)
"_.erase" spl ""
)
)
)
(prin1)
)
It uses the centers of the bounding boxes for the Circles' centers, and half the width of that for their radii. It's up to you to select appropriate Splines, but it could be made to check for certain things, such as that the bounding box at least has the same width and height [within some tolerance]. It draws the Circle(s) on the current Layer, but could put each on the same Layer as its source Spline. Etc., etc.
Nice trick @Kent1Cooper
I had some fun digging into NURBS, trying to generalize to ellipses (circles being particular ellipses).
(defun SplineToCircleOrEllipse
(spl / massoc elst ctrlPts sqrt05 p0 p2 p4 p6 ctr r1 r2 v1 v2)
(defun massoc (key alst)
(if (setq alst (member (assoc key alst) alst))
(cons (cdar alst) (massoc key (cdr alst)))
)
)
(setq elst (entget spl)
ctrlPts (massoc 10 elst) ; control points
sqrt05 (sqrt 0.5)
)
;; check the spline validity
(if (and
(= (cdr (assoc 0 elst)) "SPLINE") ; Spline
(= (logand (cdr (assoc 70 elst)) 13) 13) ; planar rational closed
(= (cdr (assoc 71 elst)) 2) ; quadratic
(= (length ctrlPts) 9) ; number of control points
(equal (massoc 41 elst) ; weights
(list 1. sqrt05 1. sqrt05 1. sqrt05 1. sqrt05 1.)
)
(setq p0 (nth 0 ctrlPts)
p2 (nth 2 ctrlPts)
p4 (nth 4 ctrlPts)
p6 (nth 6 ctrlPts)
ctr (inters p0 p4 p2 p6)
r1 (distance ctr p0)
r2 (distance ctr p2)
v1 (mapcar '- p0 ctr)
v2 (mapcar '- p2 ctr)
)
(equal (apply '+ (mapcar '* v1 v2)) 0 1e-10) ; perpendicular axis
)
(entmakex
(if (equal r1 r2 1e-12)
(list
'(0 . "CIRCLE")
(cons 10 (trans ctr 0 (cdr (assoc 210 elst))))
(cons 40 r1)
(assoc 210 elst)
)
(list
(cons 0 "ELLIPSE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbEllipse")
(cons 10 ctr)
(cons 11 (mapcar '- p0 ctr))
(assoc 210 elst)
(cons 40 (/ r2 r1))
)
)
)
)
)
The reverse process
;; MakeEllipticalSpline
;; Makes a planar rational closed cubic Spline figuring a Circle or an Ellipse.
;; Returns the created Spline ename or nil.
;;
;; Arguments
;; center: Center of the ellipse.
;; majAxis; Major axis vector.
;; majAxis; Minor axis vector (must be perpendicular to majAxis).
(defun MakeEllipticalSpline (center majAxis minAxis / ctrlPts sqrt05)
;; check if axis are perpendicular
(if (equal (apply '+ (mapcar '* majAxis minAxis)) 0 1e-10)
(progn
(setq ctrlPts (list
(mapcar '+ center majAxis)
(mapcar '+ center majAxis minAxis)
(mapcar '+ center minAxis)
(mapcar '+ center (mapcar '- majAxis) minAxis)
(mapcar '- center majAxis)
(mapcar '- center majAxis minAxis)
(mapcar '- center minAxis)
(mapcar '+ center majAxis (mapcar '- minAxis))
(mapcar '+ center majAxis)
)
sqrt05 (sqrt 0.5)
)
(entmakex
(append
(list
(cons 0 "SPLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbSpline")
(cons 70 13) ; planar rational closed
(cons 71 2) ; quadratic
(cons 72 12) ; number of knots
(cons 73 9) ; number of control points
)
(mapcar '(lambda (x) (cons 40 x)) ; knots
'(0 0 0 1 1 2 2 3 3 4 4 4)
)
(mapcar '(lambda (x) (cons 41 x)) ; weights
(list 1 sqrt05 1 sqrt05 1 sqrt05 1 sqrt05 1)
)
(mapcar '(lambda (x) (cons 10 x)) ctrlPts) ; control points
)
)
)
)
)
;; CircleOrEllipseToSpline
;; Makes a planar rational closed quadratic Spline from a Circle or an Ellipse.
;; Returns the ename of the created entity or nil.
;;
;; Argument
;; ent: Circle or Ellipse ename
(defun CircleOrEllipseToSpline (ent / elst normal majAxis minAxis)
(cond
((= (cdr (assoc 0 (setq elst (entget ent)))) "CIRCLE")
(setq normal (cdr (assoc 210 elst))
majAxis (list (cdr (assoc 40 elst)) 0. 0.)
minAxis (list 0. (cdr (assoc 40 elst)) 0.)
)
(MakeEllipticalSpline
(trans (cdr (assoc 10 elst)) normal 0)
(trans majAxis normal 0 T)
(trans minAxis normal 0 T)
)
)
((= (cdr (assoc 0 elst)) "ELLIPSE")
(setq normal (cdr (assoc 210 elst))
ratio (cdr (assoc 40 elst))
majAxis (cdr (assoc 11 elst))
minAxis (trans (mapcar
'(lambda (x) (* x ratio))
((lambda (v)
(list (- (cadr v)) (car v) (caddr v))
)
(trans majAxis 0 normal)
)
)
normal
0
)
)
(MakeEllipticalSpline
(cdr (assoc 10 elst))
majAxis
minAxis
)
)
)
)
Hi Thangs for replying, super
Regard
Henrik