i want change this autolisp to allow me select multiple polyline
this lisp convert straight segments to arc segments . but one polyline for time .
(defun c:lwsegs2arced ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n ) (vl-load-com) (defun massoclst ( key lst ) (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst))))) ) (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst ) (setq k (length (setq slst (member (assoc key lst) lst)))) (setq p (- (length lst) k)) (setq j -1) (repeat p (setq plst (cons (nth (setq j (1+ j)) lst) plst)) ) (setq plst (reverse plst)) (setq j -1) (setq m -1) (repeat k (setq j (1+ j)) (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6) (setq m (1+ m)) ) (if (and (not tst) (= n m)) (setq pslst (cons (cons key value) pslst) tst t) (setq pslst (cons (nth j slst) pslst)) ) ) (setq pslst (reverse pslst)) (append plst pslst) ) (defun v^v ( u v ) (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1)) ) (defun unit ( v ) (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v) ) (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p ) (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7)) (progn (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1)))) p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1)))) op (trans o 0 (v^v nor (unit (mapcar '- p2 p1)))) op (list (car op) (cadr op) (caddr p1p)) tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0) ) (if (inters p1p p2p op tp nil) (progn (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0)) p ) nil ) ) (progn (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor)))) (setq p (trans pp nor 0)) p ) ) ) (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (vla-startundomark doc) (if (and (setq lw (entsel "\nPick LWPOLYLINE...")) (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE") ) (progn (setq i (fix (vlax-curve-getParamAtPoint (car lw) (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0)) ) ;_ vlax-curve-getParamAtPoint ) ;_ fix p1 (vlax-curve-getPointAtParam (car lw) i) p3 (vlax-curve-getPointAtParam (car lw) (1+ i)) lw (car lw) ) (setq enxb (massoclst 42 enx)) (while (= 5 (car (setq gr (grread t)))) (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw))))) (setq b ((lambda (a) (/ (sin a) (cos a))) (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0) ) ) (setq n -1) (foreach dxf42 enxb (setq n (1+ n)) (if (= n i) (setq enx (nthmassocsubst n 42 b enx)) (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx)) ) ) (entupd (cdr (assoc -1 (entmod enx)))) ) ) (prompt "\n Nothing selected or picked object not a LWPOLYLINE ") ) (vla-endundomark doc) (princ) )
Solved! Go to Solution.
Solved by Kent1Cooper. Go to Solution.
Solved by Kent1Cooper. Go to Solution.
Solved by Kent1Cooper. Go to Solution.
@jtm2020hyo wrote:
.... the first request was to modify the original code to a more complete one . ....
Because of the way the first one works [see Post 16 again], I don't think that will be possible for multiple Polylines all selected at once. I think the best you could hope for is to be able to select them all at once, but then still need to make a bulge-defining pick separately for every one.
However, if you're willing to use a two-stage process as seems to be described in your image in Post 7 -- picking one Polyline first and using the original routine on it, and after that picking the rest of the Polylines -- a routine could combine the two, i.e. pull the bulge factor from the first one and use that in place of the 0.25 in the code in Post 18, to apply it to all of them in the second-stage selection set. Does that sound right?
@john.uhden wrote:
.... if a positive bulge were the wrong direction they could run the routine again with a negative value. ....
If a limited number from a multiple selection "went the wrong way" from such a routine [few enough that you could select them easily enough], here's a way to reverse their bulge direction:
(defun C:PRB (/ ss n pldata) ; = Polyline Reverse Bulges
;;;; [when all bulge factors within each Polyline are the same] (prompt "\nTo Reverse Polyline Bulge directions,") (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE")))) (repeat (setq n (sslength ss)) (setq pldata (entget (ssname ss (setq n (1- n))))) (entmod (subst (cons 42 (- (cdr (assoc 42 pldata)))) (assoc 42 pldata) pldata)) ) ) )
[Outside this particular situation in which all bulge factors are the same within each Polyline, if you select any with arc segments of internally differing bulge factors, it will apply the reverse of the bulge factor of the first segment only to other arc segments that initially have the same bulge factor as that first segment.]
@Kent1Cooper wrote:
.... if you're willing to use a two-stage process as seems to be described in your image in Post 7 -- picking one Polyline first and using the original routine on it, and after that picking the rest of the Polylines -- a routine could combine the two, i.e. pull the bulge factor from the first one ... to apply it to all of them in the second-stage selection set. ....
Such as in the attached PSL2A.lsp with its eponymous command [minimally tested].
As with the code in Post 18, it does not alter any segments that are already arcs in the second-stage selection set.
this work prefectly . thanks everyone for help .
How can I reward everyone?
Can't find what you're looking for? Ask the community or share your knowledge.