Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

modify lisp to allow select multiple polylines

24 REPLIES 24
SOLVED
Reply
Message 1 of 25
jtm2020hyo
3634 Views, 24 Replies

modify lisp to allow select multiple polylines

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)
)

 

24 REPLIES 24
Message 21 of 25
Kent1Cooper
in reply to: jtm2020hyo


@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?

Kent Cooper, AIA
Message 22 of 25
Kent1Cooper
in reply to: john.uhden


@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.]

Kent Cooper, AIA
Message 23 of 25
Kent1Cooper
in reply to: Kent1Cooper


@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.

Kent Cooper, AIA
Message 24 of 25
jtm2020hyo
in reply to: Kent1Cooper

this work prefectly . thanks everyone for help . 

 

How can I reward everyone?

Message 25 of 25
john.uhden
in reply to: jtm2020hyo

@jtm2020hyo wrote, "How can I reward everyone?"

 

Winning lottery numbers?

John F. Uhden

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report