Jump to content

Recommended Posts

Posted

Hi, I am trying  to write a lisp to detect overlapping polylines on Layer1 and Layer2  and draw lines only to the overlap parts on Layer3

 

I attach a dwg to see exactly what I am talking about

 

(defun c:test (/ ss ent1 ent2 intpt)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE")(8 . "LAyer1,Layer2")(410 . "Model"))))
  (if ss
    (progn
      (command "_.layiso" ss "")
      (command "_.layuniso" "_all")
      (setq ent1 (ssname ss 0))
      (setq ent2 (ssname ss 1))
      (setq intpt (vlax-curve-getclosestpointto ent1 ent2))
      (if intpt
        (progn
          (if (assoc 10 (entget intpt))
            (progn
              (command "_line" (cdr (assoc 10 (entget ent1))) (cdr (assoc 10 (entget intpt))) "")
              (command "_line" (cdr (assoc 10 (entget ent2))) (cdr (assoc 10 (entget intpt))) "")
              (command "_layer" "_m" "Layer3" "_c" "161" "" "")
            )

          )
        )
      )
    )
)
)

 

Drawing1.dwgFetching info...

Posted

This worked for me :

 

(defun c:overlapints2lines ( / ss s1 s2 i e x e1 e2 ii p1 p2 )

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

  (if (setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2"))))
    (progn
      (setq s1 (ssadd))
      (setq s2 (ssadd))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq x (entget e))
        (if (= (strcase (cdr (assoc 8 x))) (strcase "Layer1"))
          (ssadd e s1)
          (ssadd e s2)
        )
      )
      (cond
        ( (= (sslength s1) 1)
          (setq e1 (ssname s1 0))
          (foreach e2 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s2)))
            (setq ii (vlax-invoke (vlax-ename->vla-object e1) (quote intersectwith) (vlax-ename->vla-object e2) acextendnone))
            (if (= (length ii) 6)
              (progn
                (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii)))
                (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3")))
              )
            )
          )
        )
        ( (= (sslength s2) 1)
          (setq e2 (ssname s2 0))
          (foreach e1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s1)))
            (setq ii (vlax-invoke (vlax-ename->vla-object e2) (quote intersectwith) (vlax-ename->vla-object e1) acextendnone))
            (if (= (length ii) 6)
              (progn
                (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii)))
                (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3")))
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

 

Regards, M.R.

Posted

Hi marko_ribar. The code works fine, but I realized that if I use this code 2 or more times in the same drawing I have overlap lines in Layer3. Is it possible to add a filter , if on the overlap polyline parts the Layer3 line exist not draw other?

 

Thanks

Posted (edited)

Here, I've modified previous code slightly... Untested though, but it should work...

 

(defun c:overlapints2lines ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst )

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

  (if (setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2,Layer3"))))
    (progn
      (setq s1 (ssadd))
      (setq s2 (ssadd))
      (setq s3 (ssadd))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq x (entget e))
        (cond
          ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer1"))
            (ssadd e s1)
          )
          ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer2"))
            (ssadd e s2)
          )
          ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer3"))
            (ssadd e s3)
          )
        )
      )
      (repeat (setq i (sslength s3))
        (setq e (ssname s3 (setq i (1- i))))
        (setq x (entget e))
        (if (= (cdr (assoc 0 x)) "LINE")
          (setq lst (cons (cdr (assoc 10 x)) lst) lst (cons (cdr (assoc 11 x)) lst))
        )
      )
      (foreach e1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s1)))
        (foreach e2 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s2)))
          (setq ii (vlax-invoke (vlax-ename->vla-object e1) (quote intersectwith) (vlax-ename->vla-object e2) acextendnone))
          (if (= (length ii) 6)
            (progn
              (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii)))
              (if (and (not (vl-position p1 lst)) (not (vl-position p2 lst)))
                (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3")))
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

 

Regards, M.R.

Edited by marko_ribar
Posted

Thanks for the update.I have one last question. The code works for only one Layer1  polyline and multy Layer2 polylines overlap. If I have more Layer1 polylines is it possible to work  with one selection . I want to change

 

this line
(setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2,Layer3"))))


with this
(setq ss (ssget "_x" (list (cons 8 "Layer1,Layer2,Layer3"))))

 

to work for multy set of polylines Layer1 and Layer2

 

Thanks

Posted

No, "Layer1" must be with only single polyline, that's why (ssget "_:L" ...) to alow user to select only portion of drawing consisting of single polyline on Layer1...

Posted

Is it possible to work for

 

(setq ss (ssget "_x" (list (cons 8 "Layer1,Layer2,Layer3"))))

 

Thanks

Posted (edited)

Try routine now... You can changle "_:L" to "_A" if you wish, but I left it as it was before... After all it wasn't such a big mod. from me... I suppose you could figure this on your own...

Regards, M.R.

Edited by marko_ribar
Posted

Hi, I am trying  to updeate the code in the same idea to detect insede close polylines on Layer1 -> close polyline on Layer2 (inside or inside overlap to Layer1) and text inside Layer 1 on layer MY-TEXT.

 

I attach a dwg to see exactly what I am talking about

 

(defun c:TEST5 ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst )
  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (setq ss (ssget "_A" (list (cons 8 "LAYER1,LAYER2,MY-TEXT"))))
  (progn
    (setq s1 (ssadd))
    (setq s2 (ssadd))
	  (setq s3 (ssadd))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (setq x (entget e))
      (cond
        ( (= (strcase (cdr (assoc 8 x))) (strcase "LAYER1"))
          (ssadd e s1)
        )
        ( (= (strcase (cdr (assoc 8 x))) (strcase "LAYER2"))
          (ssadd e s2)
        )
		   ( (= (strcase (cdr (assoc 8 x))) (strcase "MY-TEXT"))
          (ssadd e s3)
        )
      )
    )
(foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1)))
  (foreach e2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
    (foreach e3 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s3)))
      (setq ii (vlax-invoke (vlax-ename->vla-object e1) 'intersectwith (vlax-ename->vla-object e2) acextendnone))
      (if (= (length ii) 6)
        (progn
          (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii)))
          (if (and (not (vl-position p1 lst)) (not (vl-position p2 lst)))
            (progn
              (if (= (tblsearch "layer" "BLD") nil)
                (command "_layer" "_m" "BLD" "_c" "10" "" "")
              )
              (entmod (subst (cons 8 "BLD") (assoc 8 (entget e2)) (entget e2)))
              (entmod (subst (cons 8 "BLD") (assoc 8 (entget e3)) (entget e3)))
            )
          )
        )
      )
    )
  )
    )
  )
  (princ)
)

 

Can any one help ?

 

Thanks

Drawing1.dwgFetching info...

Posted

I make a second try for the code but in the first example in the drawing the code work fine , in the second example not working select all layer 2 . I dont'know why. Can any one fix the code?

 

(defun c:foo2 ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst inside? get-polyline-vertices)

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

  ;; Select all entities on the specified layers
   (setq ss (ssget "_A" (list (cons 8 "LAYER1,LAYER2,MY-TEXT"))))

  ;; Initialize selection sets for each layer
  (progn
    (setq s1 (ssadd))
    (setq s2 (ssadd))
    (setq s3 (ssadd))

    ;; Iterate through the selection set and add entities to their respective layer selection set
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (setq x (entget e))
      (cond
        ((= (strcase (cdr (assoc 8 x))) "LAYER1")
          (ssadd e s1))
        ((= (strcase (cdr (assoc 8 x))) "LAYER2")
          (ssadd e s2))
        ((= (strcase (cdr (assoc 8 x))) "MY-TEXT")
          (ssadd e s3))
      )
    )

    ;; Define a function to check if a point is inside a ccw polyline
    (defun inside? (pt pl / minx maxx miny maxy)
      ;; Calculate the bounding box of the polyline
      (setq minx (apply 'min (mapcar 'car pl)))
      (setq maxx (apply 'max (mapcar 'car pl)))
      (setq miny (apply 'min (mapcar 'cadr pl)))
      (setq maxy (apply 'max (mapcar 'cadr pl)))
      ;; Check if the point is within the bounding box
      (and (>= (car pt) minx) (<= (car pt) maxx)
           (>= (cadr pt) miny) (<= (cadr pt) maxy))
    )

    ;; Define a function to retrieve the vertices of a polyline
    (defun get-polyline-vertices (e / obj len inc pt pts)
      (setq obj (vlax-ename->vla-object e))
      (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
      (setq inc 0.0)
      (setq pts '())
      (while (<= inc len)
        (setq pt (vlax-curve-getPointAtDist obj inc))
        (setq pts (cons pt pts))
        (setq inc (+ inc (vlax-curve-getDistAtParam obj 1.0)))
      )
      (reverse pts)
    )

    ;; Process the entities on Layer1
    (foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1)))
      ;; Get the vertices of the ccw polyline
      (setq pl (get-polyline-vertices e1))
      ;; Process the entities on Layer2
      (foreach e2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
        ;; Check if the polyline on Layer2 is inside or overlaps with the ccw polyline on Layer1
        (if (inside? (vlax-curve-getStartPoint (vlax-ename->vla-object e2)) pl)
          ;; If inside or overlapping, change the layer to "BLD"
          (entmod (subst (cons 8 "BLD") (assoc 8 (entget e2)) (entget e2)))
        )
      )
      ;; Process the text entities on MY-TEXT
      (foreach e3 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s3)))
        ;; Check if the text entity is inside the ccw polyline on Layer1
        (if (inside? (cdr (assoc 10 (entget e3))) pl)
          ;; If inside, change the layer to "BLD"
          (entmod (subst (cons 8 "BLD") (assoc 8 (entget e3)) (entget e3)))
		       
        )
      )
    )
  )
  (princ)
)

 

Thanks

Drawing1.dwgFetching info...

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.

×
×
  • Create New...