draw green line by select inner polyline & outer polyline

[Biswanath Das]

[rkmcswain]

Is there a question here?

 

Are you asking someone to write you some lisp code to do this?

 

Have you started or attempted to start writing this?

 

Thanks.

[devitg]

On 10/12/2018 at 7:23 AM, Biswanath Das said:

 

[devitg]

Please upload a sample.dwg

[BIGAL]

Do you really need a sample ? Just make something, use compare distance of co-ords should work with object1 object2.

 

; join corners of inside & outside plines
; by Alan H Oct 2018

; pline co-ords example
; By Alan H
(defun getcoords (ent)
  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property
    obj
    "Coordinates"
      )
    )
  )
)
 
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(defun co-ords2xy ()
(setq co-ordsxy '())
(setq len (length co-ords))
(if (= (vla-get-objectname obj) "AcDbLwpolyline")
(setq numb (/ len 2)) ; even and odd check required
(setq numb (/ len 2)))
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

; program starts here
; list of 2d points making pline
(setq obj (vlax-ename->vla-object (car (entsel "\nplease pick pline"))))
(setq co-ords (getcoords obj))
(co-ords2xy)
(setq co-ordsxy1 co-ordsxy)


(setq obj (vlax-ename->vla-object (car (entsel "\nplease pick pline"))))
(setq co-ords (getcoords obj))
(co-ords2xy)

(repeat (setq x (length co-ordsxy1))
(setq pt1 (nth (setq x (- x 1)) co-ordsxy1))
(setq dist 10000000.0)
(repeat (setq y (length co-ordsxy))
(setq pt2 (nth (setq y (- y 1)) co-ordsxy))
(setq dist1 (distance pt1 pt2))
(if (< dist1 dist)
(progn
(setq dist dist1)
(setq pt3 pt1 pt4 pt2)
)
)
)
(command "line" pt3 pt4 "")
)

 

[Roy_043]

@BIGAL

If you select the inner pline first and that pline is much smaller than the outer one, and tucked into one of the latter's corners, the result of your code is not as intended. Also your code does not take the OSMODE into account.

Edited October 14, 2018 by Roy_043

[Lee Mac]

Orthogonal WCS rectangles only -

(defun c:rr ( / a i l m s v x )
    (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq i (sslength s))
                (setq i (1- i)
                      v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget (ssname s i))))
                      a (rem (angle (car v) (cadr v)) (/ pi 2.0))
                )
                (if (and (equal (distance (car  v) (cadr  v)) (distance (caddr v) (cadddr v)) 1e-8)
                         (equal (distance (cadr v) (caddr v)) (distance (car   v) (cadddr v)) 1e-8)
                         (equal (distance (car  v) (caddr v)) (distance (cadr  v) (cadddr v)) 1e-8)
                         (or (equal a 0.0 1e-8) (equal a (/ pi 2.0) 1e-8))
                    )
                    (progn
                        (if (apply 'LM:clockwise-p (mapcar '(lambda ( a b ) a) v '(0 1 2)))
                            (setq v (reverse v))
                        )
                        (setq m (apply 'mapcar (cons 'min v)))
                        (while (not (equal m (car v) 1e-8))
                            (setq v (append (cdr v) (list (car v))))
                        )
                        (setq l (cons v l))
                    )
                )
            )
            (setq l (vl-sort l '(lambda ( a b ) (< (caar a) (caar b)))))
            (while (setq x (car l))
                (setq l
                    (vl-remove-if
                        (function
                            (lambda ( y )
                                (if (vl-every '<= (car x) (car y) (caddr y) (caddr x))
                                    (mapcar
                                        (function
                                            (lambda ( a b )
                                                (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 b)))
                                            )
                                        )
                                        x y
                                    )
                                )
                            )
                        )
                        (cdr l)
                    )
                )
            )
        )
    )
    (princ)
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:clockwise-p ( p1 p2 p3 )
    (<  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
        (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
    )
)

(princ)

 

[BIGAL]

Nice one Lee as usual

 

Roy we can only make an educated guess based on what is 1st provided, you are right that we dont know what the end user is going to throw at it. placing a rectang into a corner may not be the case I tried a inner pline on an angle and it really screwed up. You are right often osmode 0 is required but the image suggested it was not required. Similar with Lee's examples    

 

 

[Biswanath Das]

thanks all

[Biswanath Das]

but when the object rotated do't work

Drawing2.dwg

[Lee Mac]

3 hours ago, Biswanath Das said:

but when the object rotated do't work

Drawing2.dwg

 

As noted in my post - the posted program is compatible with "orthogonal rectangles only".

[Roy_043]

Devitg's request for a (good) sample dwg is not so strange after all...

[Lee Mac]

2 hours ago, Roy_043 said:

Devitg's request for a (good) sample dwg is not so strange after all...

 

Indeed - I enjoyed writing the code nonetheless

[ronjonp]

Here's another to do one at at a time rotated or not.

(defun c:foo (/ p2 s)
  ;; RJP » 2018-10-24
  (cond	((and (setq s (ssget '((0 . "lwpolyline")))) (= 2 (sslength s)))
	 (setq s (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
			  '(lambda (r j) (> (vlax-curve-getarea r) (vlax-curve-getarea j)))
		 )
	 )
	 (foreach p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget (car s))))
	   (if (setq p2 (vlax-curve-getclosestpointto (cadr s) p))
	     (entmakex (list '(0 . "line") (cons 10 p) (cons 11 p2) '(62 . 3)))
	   )
	 )
	)
  )
  (princ)
)
(vl-load-com)

 

[Lee Mac]

Try the following for rectangles at any rotation & orientation:

;; Rectangle in Rectangle  -  Lee Mac
;; Constructs lines between the vertices of rectangles inside rectangles.

(defun c:rr ( / a e i l m p r s v x )
    (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq i (sslength s))
                (setq i (1- i)
                      e (entget (ssname s i))
                      v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) e))
                      a (angle (car v) (cadr v))
                )
                (if (and (equal (distance (car  v) (cadr  v)) (distance (caddr v) (cadddr v)) 1e-8)
                         (equal (distance (cadr v) (caddr v)) (distance (car   v) (cadddr v)) 1e-8)
                         (equal (distance (car  v) (caddr v)) (distance (cadr  v) (cadddr v)) 1e-8)
                    )
                    (progn
                        (if (apply 'LM:clockwise-p (mapcar '(lambda ( a b ) a) v '(0 1 2)))
                            (setq v (reverse v))
                        )
                        (setq m (list (list (cos a) (sin a)) (list (- (sin a)) (cos a)))
                              r (mapcar '(lambda ( x ) (mxv m x)) v)
                              p (apply 'mapcar (cons 'min r))
                        )
                        (while (not (equal p (car r) 1e-8))
                            (setq r (append (cdr r) (list (car r)))
                                  v (append (cdr v) (list (car v)))
                            )
                        )
                        (setq l (cons (list r v (cdr (assoc 38 e)) (cdr (assoc 210 e))) l))
                    )
                )
            )
            (setq l (vl-sort l '(lambda ( a b ) (< (caaar a) (caaar b)))))
            (while (setq x (car l))
                (setq l
                    (vl-remove-if
                        (function
                            (lambda ( y / n z )
                                (if
                                    (and
                                        (vl-every '<= (caar x) (caar y) (caddar y) (caddar x))
                                        (equal (setq z (caddr  x)) (caddr  y) 1e-8)
                                        (equal (setq n (cadddr x)) (cadddr y) 1e-8)
                                    )
                                    (mapcar
                                        (function
                                            (lambda ( a b )
                                                (entmake
                                                    (list
                                                       '(000 . "LINE")
                                                        (cons 010 (trans (append a (list z)) n 0))
                                                        (cons 011 (trans (append b (list z)) n 0))
                                                    )
                                                )
                                            )
                                        )
                                        (cadr x) (cadr y)
                                    )
                                )
                            )
                        )
                        (cdr l)
                    )
                )
            )
        )
    )
    (princ)
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:clockwise-p ( p1 p2 p3 )
    (<  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
        (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
    )
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

Edited October 24, 2018 by Lee Mac

[Stefan BMR]

On 10/14/2018 at 4:26 PM, Lee Mac said:

(and
  (equal (distance (car v) (cadr v)) (distance (caddr v) (cadddr v)) 1e-8)
  (equal (distance (cadr v) (caddr v)) (distance (car v) (cadddr v)) 1e-8)
  (equal (distance (car v) (caddr v)) (distance (cadr v) (cadddr v)) 1e-8)
)

 

Lee, this is not always enough to test for rectangles. Try on a polyline passing these vertexes: ((0 3) (10 3) (9 6) (1 0)). This shape will also pass the angle test

(or (equal a 0.0 1e-8) (equal a (/ pi 2.0) 1e-8))

I remember a discussion on The Swamp about regtangle-p lisp, but I don't know if there is a conclusion there.

[Lee Mac]

2 hours ago, Stefan BMR said:

Lee, this is not always enough to test for rectangles. Try on a polyline passing these vertexes: ((0 3) (10 3) (9 6) (1 0)). This shape will also pass the angle test

(or (equal a 0.0 1e-8) (equal a (/ pi 2.0) 1e-8))

I remember a discussion on The Swamp about regtangle-p lisp, but I don't know if there is a conclusion there.

 

Good counterexample Stefan.

 

I've also realised another issue with my current algorithm...

[Lee Mac]

2 hours ago, Stefan BMR said:

Lee, this is not always enough to test for rectangles. Try on a polyline passing these vertexes: ((0 3) (10 3) (9 6) (1 0)). This shape will also pass the angle test

(or (equal a 0.0 1e-8) (equal a (/ pi 2.0) 1e-8))

I remember a discussion on The Swamp about regtangle-p lisp, but I don't know if there is a conclusion there.

 

I think the following should solve this issue -

;; Rectangle-p  -  Lee Mac
;; Returns T if the supplied point list represents a rectangle

(defun LM:rectangle-p ( lst )
    (and
        (= 4 (length lst))
        (equal (distance (car  lst) (cadr  lst)) (distance (caddr lst) (cadddr lst)) 1e-8)
        (equal (distance (cadr lst) (caddr lst)) (distance (car   lst) (cadddr lst)) 1e-8)
        (equal (distance (car  lst) (caddr lst)) (distance (cadr  lst) (cadddr lst)) 1e-8)
        (apply '=
            (mapcar 'LM:clockwise-p lst
                (append (cdr  lst) (list (car lst)))
                (append (cddr lst) (list (car lst) (cadr lst)))
            )
        )
    )
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:clockwise-p ( p1 p2 p3 )
    (<  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
        (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
    )
)

I omitted the test for orthogonality with the coordinate axes, as this is a special case.

Edited October 24, 2018 by Lee Mac

[BIGAL]

As usual Lee brilliant think out of the square, no why not the obtuse 3rd angle projected object.

[Biswanath Das]

THANKS TO ALL