Jump to content
Biswanath Das

draw green line by select inner polyline & outer polyline

Recommended Posts

Biswanath Das

Untitled.jpg

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
devitg
On 10/12/2018 at 7:23 AM, Biswanath Das said:

Untitled.jpg

 

Share this post


Link to post
Share on other sites
devitg

Please upload a sample.dwg

Share this post


Link to post
Share on other sites
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 "")
)

 

Share this post


Link to post
Share on other sites
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 by Roy_043

Share this post


Link to post
Share on other sites
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)

rectangleinrectangle.gif.b64cff801aa31bbdc1e0e18b196d9666.gif

 

Share this post


Link to post
Share on other sites
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    

 

 

Share this post


Link to post
Share on other sites
Biswanath Das

thanks all

Share this post


Link to post
Share on other sites
Biswanath Das

but when the object rotated do't work

Drawing2.dwg

Share this post


Link to post
Share on other sites
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".

Share this post


Link to post
Share on other sites
Roy_043

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

Share this post


Link to post
Share on other sites
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 :)

Share this post


Link to post
Share on other sites
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)

 

2018-10-24_8-45-16.gif

Share this post


Link to post
Share on other sites
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)

rectangleinrectangle2.gif.c78fe46612fd0629d7437422544eae27.gif

Edited by Lee Mac
  • Like 1

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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...

rrissue.png.a1f4765c2f699ef26daa1ee0716fc546.png

Share this post


Link to post
Share on other sites
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 by Lee Mac

Share this post


Link to post
Share on other sites
BIGAL

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

Share this post


Link to post
Share on other sites
Biswanath Das

THANKS TO ALL

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×