PROFILE RADIUS SIZE CHANGE INNER RADIUS AND OUTER RADIUS
It's late here at my location to start writing lisp code, and this request is not so easy to solve.
If you don't have way to many profiles to redraw you can use command FILLET in multiple mode with
radius 0 to remove all arc segments from a profile and than recreate new arc segments by also using command FILLET.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I'll try to write some code. Please attach sample drawing with various profiles so that I can check how they are created. What version of Autocad you are using? I see a lots of heavy polylines in your samples.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Now this is getting interesting. There are indeed different types of polyline on your drawing sample and some corners with no radius.
Any chance you may also have 3D polyline in the future?
@ptdesignYou don't have to accept every post as a solution. Leave this only for a posts that truly solve it.
"i am using AutoCAD 2021, what you mean (I see a lots of heavy polylines in your samples. )"
When I extract entity definition of provided samples using
(entget (car (entsel "\nSelect entity")))Some are defined as (0 . "POLYLINE"), and other (0 . "LWPOLYLINE") that is heavy or lightweight polyline.
From a code perspective this are two different types and require different coding.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Use command "CONVERTPOLY" and choose L option.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I've been working on a code and can say that this task is not easy. It is actually a kind of tasks where you can't be certain that code works well.
My idea:
1 ) Convert to LW polyline
2) collect all segments and divide to linear and arc (pt1 bulge pt2)
3) Sort outer and inner radiuses ----PTDESIGN give more details
4) Fillet polyline with radius 0 to remove all arcs
5) For all arc segments depending on position (in out) make change on defining points and linear segments. Defining points move closer or apart for delta radius increase or decrease along neighboring linear segment, bulge value is not changed. Create modified arcs and use bpoly to create boundary i.e. re-modify old shape
6 Erase all helping entities
I s
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Would you use this only on shapes whose line segments are all parallel and perpendicular to each other, with 90°-tangent-arc corners, as in your example? If so, and if all are [or are converted to] LWPolylines, then the bulge factors of all the arc segments in entity data will always be for a 90° arc, i.e. (42 . 0.414214) or (42 . -0.414214). Those will not change -- it is only necessary to move the vertices at the ends of the arc segments, and the radius will adjust accordingly. Depending on a combination of whether the Polyline's drawn direction is CW or CCW and whether an arc segment's bulge factor is positive or negative, the vertex at the start of the segment needs to be moved outward or inward relative to the arc, by the same distance as the desired change in radius, and the one at the end of it in the other direction. An adjusted list of vertex coordinates can be built, and the 'Coordinates VLA property can be replaced with it.
That seems like something that would not be too complicated to work out, but it does depend on the line segments all being parallel/perpendicular, and all arc segments being 90° arcs. Nothing like these kinds of corners:
If "off" conditions like those may occur, then the amount of change in vertex positions would not always be the same as the change in radius. [That's probably calculable, but I think quite a bit more complicated.]
Does that sound worth pursuing?
@ptdesignI understand what you are talking about i.e inner or outer radiuses . My secondary education is in machining and have been working int this field for a few years. Problem is how to define mathematical logic that would distinguish those two types of arcs in a single polyline entity in automatic execution, since you want to avoid any selection or splitting).
@Kent1CooperYou've in more details described algorithm similar to what I have proposed.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Instead of building complex algorithm that can fail to determine if arc is inner our outer, try this.
Before using convert all polylines to lwpolylines.
Code iterates around profile shape, stops at every arc segment marked with temporary circle
and you enter new radius value. This way you can make different changes not just +- 0.1,
and linear segments can be drawn at any angle. To skip arc segments just hit <enter>.
Before applying changes try to zoom at shape so it is fully shown on screen, or re-zoom to find marking circle.
At the end use command "JOIN" W and select all entities that define this shape to join into single lwpolyline.
(defun c:rfc ( / *error* LM:Bulge->Arc lwpoly_segs adoc e segs arc_segs cir c r r1 tc)
;author: hak_vz 02.03.2021 for ptdesign (Mr.Ang)
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/profile-radius-size-change-inner-radius-and-outer-radius/td-p/10118360
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort" "Automation Error. Object was erased")))
(princ (strcat "\nError: " msg))
)
(if adoc (vla-endundomark adoc))
(command "_.ucs" "p")
(setvar 'cmdecho 0)
(princ)
)
(defun LM:Bulge->Arc ( p1 p2 b / a c r )
(setq a (* 2 (atan b))
r (/ (distance p1 p2) 2 (sin a))
c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
)
(if (minusp b)
(list c (angle c p2) (angle c p1) (abs r))
(list c (angle c p1) (angle c p2) (abs r))
)
)
(defun lwpoly_segs ( e / ent p1 pt bulge seg seglst)
(setq ent (entget e))
(cond (ent
(if (= (logand (cdr (assoc 70 ent)) 1) 1)
(setq p1 (cdr (assoc 10 ent)))
)
(while (setq ent (member (assoc 10 ent) ent))
(setq seg nil)
(if (and pt bulge)
(setq seg (list pt bulge))
)
(setq pt (cdr (assoc 10 ent))
ent (member (assoc 42 ent) ent)
bulge (cdar ent)
)
(if seg
(setq seg (list (car seg)(cadr seg)pt)
seglst (cons seg seglst))
)
)
)
)
(if p1 (setq seglst (cons (list pt bulge p1) seglst)))
(reverse seglst)
)
(command "_.ucs" "w")
(setvar 'cmdecho 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq e (car (entsel "\n Select entity >")))
(cond
((and e)
(vla-endundomark adoc)
(vla-startundomark adoc)
(setq segs (lwpoly_segs e))
(foreach seg segs
(if (/= (cadr seg) 0.0)
(setq arc_segs (cons seg arc_segs))
)
)
(setq arc_segs (reverse arc_segs))
(command "_.fillet" "p" "r" 0.0 e)
(command "_.explode" e)
(cond
((and arc_segs)
(foreach mm arc_segs
(setq cir (LM:Bulge->Arc (car mm) (last mm) (cadr mm)))
(setq c (car cir) r (last cir))
(command "_.circle" c (* 2.5 r))
(setq tc (entlast))
(setq r1 (getreal (strcat "\nEnter new arc radius at position. Current radius is " (rtos r 2 3) " >")))
(if (not r1) (setq r1 r))
(setvar 'filletrad r)
(command "_.fillet" (car mm) (last mm) "")
(entdel tc)
)
)
)
(vla-endundomark adoc)
)
)
(command "_.ucs" "p")
(setvar 'cmdecho 0)
(princ)
)
(princ "\n Command RFC iteratively changes arch radiuses in lwpolyline!")
(princ)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@ptdesign wrote:
please advise ptdesign
-please advise ptdesign - <--- Why are you referring to yourself in the third person like Terry in NineNine? 😀
Did you try the code at post # 8 by @hosneyalaa ? A little more tweak then you will get you desired result.
Corrected code
(defun c:rfc ( / *error* LM:Bulge->Arc lwpoly_segs adoc e segs arc_segs cir c r r1 tc)
;author: hak_vz 02.03.2021 for ptdesign (Mr.Ang)
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/profile-radius-size-change-inner-radius-and-outer-radius/td-p/10118360
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort" "Automation Error. Object was erased")))
(princ (strcat "\nError: " msg))
)
(if adoc (vla-endundomark adoc))
(command "_.ucs" "p")
(setvar 'cmdecho 0)
(princ)
)
(defun LM:Bulge->Arc ( p1 p2 b / a c r )
(setq a (* 2 (atan b))
r (/ (distance p1 p2) 2 (sin a))
c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
)
(if (minusp b)
(list c (angle c p2) (angle c p1) (abs r))
(list c (angle c p1) (angle c p2) (abs r))
)
)
(defun lwpoly_segs ( e / ent p1 pt bulge seg seglst)
(setq ent (entget e))
(cond (ent
(if (= (logand (cdr (assoc 70 ent)) 1) 1)
(setq p1 (cdr (assoc 10 ent)))
)
(while (setq ent (member (assoc 10 ent) ent))
(setq seg nil)
(if (and pt bulge)
(setq seg (list pt bulge))
)
(setq pt (cdr (assoc 10 ent))
ent (member (assoc 42 ent) ent)
bulge (cdar ent)
)
(if seg
(setq seg (list (car seg)(cadr seg)pt)
seglst (cons seg seglst))
)
)
)
)
(if p1 (setq seglst (cons (list pt bulge p1) seglst)))
(reverse seglst)
)
(command "_.ucs" "w")
(setvar 'cmdecho 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq e (car (entsel "\n Select entity >")))
(cond
((and e)
(vla-endundomark adoc)
(vla-startundomark adoc)
(setq segs (lwpoly_segs e))
(foreach seg segs
(if (/= (cadr seg) 0.0)
(setq arc_segs (cons seg arc_segs))
)
)
(setq arc_segs (reverse arc_segs))
(command "_.fillet" "p" "r" 0.0 e)
(command "_.explode" e)
(cond
((and arc_segs)
(foreach mm arc_segs
(setq cir (LM:Bulge->Arc (car mm) (last mm) (cadr mm)))
(setq c (car cir) r (last cir))
(command "_.circle" c (* 2.5 r))
(setq tc (entlast))
(setq r1 (getreal (strcat "\nEnter new arc radius at position. Current radius is " (rtos r 2 3) " >")))
(if (not r1) (setq r1 r))
(setvar 'filletrad r1)
(command "_.fillet" (car mm) (last mm))
(entdel tc)
)
)
)
(vla-endundomark adoc)
)
)
(command "_.ucs" "p")
(setvar 'cmdecho 0)
(princ)
)
(princ "\n Command RFC iteratively changes arch radiuses in lwpolyline!")
(princ)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
