Jump to content

Adjust polyline sides

mhy3sx

By mhy3sx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mhy3sx Community Regular

mhy3sx

Posted
Posted

Hi, I am trying to write a code to adjust polyline sides. I use a lot of baundaries in my drawings and some times the polyline is not mach. Some vertex are not match.


Look the attach dwg for more instractions

 

The code so far identify not mach vertex on polylines

  

        (defun c:foo ( / ss pl1 pl2 pl:lst1 pl:lst2 a cnt chk)
         (setq ss (ssadd))
         (While (not (= (sslength ss) 2))
          (princ "\nSelect 2 LwPolylines: ")
          (setq ss (ssget (list (cons 0 "LWPOLYLINE"))))
          (if (not (= (sslength ss) 2)) (princ "\nMust Select 2 LWPolylines to compare"))
         )
         (command "_layer" "_m" "Check_Mark" "_c" "140" "" "")
         (setq pl1 (ssname ss 0) pl2 (ssname ss 1))
         (setq pl:lst1 (getcoords pl1) pl:lst2 (getcoords pl2))

         (foreach a pl:lst1
          (progn
           (setq cnt 0)
           (setq chk nil)
           (repeat (length pl:lst2)
            (if (and (= (car a) (car (nth cnt pl:lst2))) (= (cadr a) (cadr (nth cnt pl:lst2))))
             (setq chk T)
            )
            (setq cnt (1+ cnt))
           )
           (if (not chk)
           (entmakex (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 62 140) (cons 10 a) (cons 40 0.20)))
           )
          )
         )

         (foreach a pl:lst2
          (progn
           (setq cnt 0)
           (setq chk nil)
           (repeat (length pl:lst1)
            (if (and (= (car a) (car (nth cnt pl:lst1))) (= (cadr a) (cadr (nth cnt pl:lst1))))
             (setq chk T)
            )
            (setq cnt (1+ cnt))
           )
           (if (not chk)
          (entmakex (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 62 10) (cons 10 a) (cons 40 0.20)))
           )
          )
         )

         (princ)
        )

        (defun getcoords (ent / lst1 lst2)
         (setq lst1 (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) "Coordinates"))))
         (setq lst2 (list))
         (While lst1
          (setq lst2 (append lst2 (list (list (car lst1) (cadr lst1)) )))
          (setq lst1 (cddr lst1))
         )
         (if lst2 lst2 (princ))
        )

 


Thanks

test.dwg

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Hi, @mhy3sx

Try this code with fuzz distance = 1.0...

If you are satisfied, please like this answer...

  

(defun c:adj_lw1_lw2 ( / vertlst lw1 lw2 enx1 enx2 fuzz vl1 vl2 enx )

  (defun vertlst ( lw / enx )
    (mapcar
      (function
        (lambda ( p )
          (append
            (mapcar (function +) (list 0.0 0.0) (trans p lw 0))
            (list (cdr (assoc 38 enx)))
          )
        )
      )
      (mapcar (function cdr)
        (vl-remove-if
          (function
            (lambda ( x )
              (/= (car x) 10)
            )
          )
          (setq enx (entget lw))
        )
      )
    )
  )

  (if
    (and
      (setq lw1 (car (entsel "\nPick LWPOLYLINE you want as adjusting reference...")))
      (= (cdr (assoc 0 (setq enx1 (entget lw1)))) "LWPOLYLINE")
      (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) enx1))
      (setq lw2 (car (entsel "\nPick LWPOLYLINE you want to adjust...")))
      (= (cdr (assoc 0 (setq enx2 (entget lw2)))) "LWPOLYLINE")
      (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) enx2))
      (not (initget 7))
      (setq fuzz (getdist "\nPick or specify fuzz distance : "))
    )
    (progn
      (setq vl1 (vertlst lw1))
      (setq vl2 (vertlst lw2))
      (foreach v1 vl1
        (foreach v2 vl2
          (if (<= (distance v1 v2) fuzz)
            (setq vl2 (subst v1 v2 vl2))
          )
        )
      )
      (setq enx (entget lw2))
      (setq enx (subst (cons 38 (caddar vl2)) (assoc 38 enx) enx))
      (setq enx (subst (cons 90 (length vl2)) (assoc 90 enx) enx))
      (setq enx
        (append
          (reverse
            (cdr
              (member (assoc 10 enx) (reverse enx))
            )
          )
          (mapcar
            (function
              (lambda ( p )
                (cons 10 (trans p 0 lw2))
              )
            )
            vl2
          )
          (list (assoc 210 enx))
        )
      )
      (entupd (cdr (assoc -1 (entmod enx))))
    )
    (prompt "\nMissed or picked wrong entity type... You must pick LWPOLYLINE entities with only straight segments... Better luck next time...")
  )
  (princ)
)

 

HTH.

M.R.

Edited by marko_ribar
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

Hi marko_ribar. Thanks for the help. I try the code but don't work as I expect. Don't perfect mach the sides of the polylines and if I give a little more tolerance transform badly the second polyline.I want to match the sides (in tolerance) , delete and add vertex for perfect match.

 

Thanks

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

@mhy3sx

If you want my revision of the code I provided, you should like my reply... This way we know you are interested in topic you raised... If you still avoid to give encouragement I shell not post my revision... Thanks for attention and good bye...

Edited by marko_ribar
  • Like 1
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

OK, I see that @Dadgad gave me like...

I'll post my revision...

Here you are :

  

(defun c:adj_lw1_lw2-new ( / vertlst unique lwupd lw1 lw2 enx1 enx fuzz vl1 vl2 bl par )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun vertlst ( lw / enx )
    (mapcar
      (function
        (lambda ( p )
          (append
            (mapcar (function +) (list 0.0 0.0) (trans p lw 0))
            (list (cdr (assoc 38 enx)))
          )
        )
      )
      (mapcar (function cdr)
        (vl-remove-if
          (function
            (lambda ( x )
              (/= (car x) 10)
            )
          )
          (setq enx (entget lw))
        )
      )
    )
  )

  (defun unique ( lst fuzz / a ll )
    (while (setq a (car lst))
      (if (vl-some (function (lambda ( x ) (equal x a fuzz))) (cdr lst))
        (setq ll (cons a ll) lst (vl-remove-if (function (lambda ( x ) (equal x a fuzz))) (cdr lst)))
        (setq ll (cons a ll) lst (cdr lst))
      )
    )
    (reverse ll)
  )

  (defun lwupd nil
    (setq enx (subst (cons 38 (caddar vl2)) (assoc 38 enx) enx))
    (setq enx (subst (cons 90 (length vl2)) (assoc 90 enx) enx))
    (setq enx
      (append
        (reverse
          (cdr
            (member (assoc 10 enx) (reverse enx))
          )
        )
        (mapcar
          (function
            (lambda ( p )
              (cons 10 (trans p 0 lw2))
            )
          )
          vl2
        )
        (list (assoc 210 enx))
      )
    )
    (entupd (cdr (assoc -1 (entmod enx))))
  )

  (if
    (and
      (setq lw1 (car (entsel "\nPick LWPOLYLINE you want as adjusting reference...")))
      (= (cdr (assoc 0 (setq enx1 (entget lw1)))) "LWPOLYLINE")
      (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) enx1))
      (setq lw2 (car (entsel "\nPick LWPOLYLINE you want to adjust...")))
      (= (cdr (assoc 0 (setq enx (entget lw2)))) "LWPOLYLINE")
      (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) enx))
      (princ "\nPick or specify fuzz distance <1.0> : ")
      (not (initget 6))
      (setq fuzz (cond ( (getdist) ) ( 1.0 )))
    )
    (progn
      (setq vl1 (vertlst lw1))
      (setq vl2 (vertlst lw2))
      (setq vl2 (unique vl2 (* fuzz 0.5)))
      (foreach v1 vl1
        (foreach v2 vl2
          (if (<= (distance v1 v2) fuzz)
            (setq vl2
              (mapcar
                (function
                  (lambda ( x )
                    (if (equal x v2 (* fuzz 1e-12)) v1 x)
                  )
                )
                vl2
              )
            )
          )
        )
      )
      (setq vl2 (unique vl2 (* fuzz 0.5)))
      (foreach v vl1
        (if
          (and
            (not (vl-position v vl2))
            (<= (distance v (vlax-curve-getclosestpointto lw2 v)) fuzz)
            (setq par (vlax-curve-getparamatpoint lw2 (vlax-curve-getclosestpointto lw2 v)))
          )
          (setq vl2
            (append
              (reverse
                (member (nth (fix par) vl2) (reverse vl2))
              )
              (list v)
              (member (nth (1+ (fix par)) vl2) vl2)
            )
          )
        )
      )
      ;|
      (mapcar
        (function
          (lambda ( a b c )
            (if (equal (distance a c) (+ (distance a b) (distance b c)) (* fuzz 5e-5))
              (setq bl (cons b bl))
            )
          )
        )
        vl2
        (append (cdr vl2) (list (car vl2)))
        (append (cddr vl2) (list (car vl2) (cadr vl2)))
      )
      (foreach b (unique bl (* fuzz 1e-12))
        (setq vl2 (vl-remove b vl2))
      )
      |;
      (setq vl2 (unique vl2 (* fuzz 0.5)))
      (foreach v vl1
        (lwupd)
        (if
          (and
            (not (vl-position v vl2))
            (vl-some
              (function
                (lambda ( x )
                  (<= (distance x v) fuzz)
                )
              )
              vl2
            )
            (vl-some
              (function
                (lambda ( a b )
                  (equal (distance a b) (+ (distance a v) (distance v b)) (* fuzz 1e-3))
                )
              )
              vl2
              (append (cdr vl2) (list (car vl2)))
            )
            (setq par (vlax-curve-getparamatpoint lw2 (vlax-curve-getclosestpointto lw2 v)))
          )
          (setq vl2
            (append
              (reverse
                (member (nth (fix par) vl2) (reverse vl2))
              )
              (list v)
              (member (nth (1+ (fix par)) vl2) vl2)
            )
          )
        )
      )
      (lwupd)
    )
    (prompt "\nMissed or picked wrong entity type... You must pick LWPOLYLINE entities with only straight segments... Better luck next time...")
  )
  (princ)
)

 

HTH.

M.R.

Edited by marko_ribar
  • Like 1
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

Nice update marko_ribar. I try the code but miss one vertex. I dont know why.

 

Thanks

test.dwg

marko_ribar Veteran

marko_ribar

Posted
Posted

Hi @mhy3sx...

I've updated my last posted code... Now it won't miss anything... I checked it and it worked well with fuzz = 1.0...

 

HTH.

Regards, M.R.

  • Like 1
  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...