"3D" Rectangle

[whosa]

Hi,

 

i would like to make rectangle (or close polyline) inside a 3d solid.

 

Right now i use:

 

Ucs + Face + first corner of rectangle and second corner of rectangle.

 

I would like to do this by lisp.

 

Something like:

 

1st click: first corner

 

2nd click: second corner

 

Drawing a rectangle whit two point meaning the yellow edge of the rectangle must to be parallel to z axis.

 

 

If someone can help me would be great.

 

Thanks

Edited January 19, 2017 by whosa

[BIGAL]

UCS X 90 maybe

[Roy_043]

Try:

(defun c:3DRect ( / doc firstP normal pt1 pt2 pt3 pt4)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc) ; End open undo group.
 (vla-startundomark doc)
 (if
   (and
     (setq pt1 (getpoint "\nFirst corner: "))
     (setq pt3 (getpoint pt1 "\nOther corner: "))
     (setq normal
       (mapcar '(lambda (a b) (if (equal a b 1e- 1 0)) pt1 pt3)
     )
     (= 1 (apply '+ normal))
   )
   (progn
     (setq pt2
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt1
         pt3
       )
     )
     (setq pt4
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt3
         pt1
       )
     )
     (setq normal (trans normal 1 0 T))
     (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 1 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 1 normal))
         (cons 10 (trans pt2 1 normal))
         (cons 10 (trans pt3 1 normal))
         (cons 10 (trans pt4 1 normal))
         (cons 210 normal)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

[whosa]

Try:

(defun c:3DRect ( / doc firstP normal pt1 pt2 pt3 pt4)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc) ; End open undo group.
 (vla-startundomark doc)
 (if
   (and
     (setq pt1 (getpoint "\nFirst corner: "))
     (setq pt3 (getpoint pt1 "\nOther corner: "))
     (setq normal
       (mapcar '(lambda (a b) (if (equal a b 1e- 1 0)) pt1 pt3)
     )
     (= 1 (apply '+ normal))
   )
   (progn
     (setq pt2
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt1
         pt3
       )
     )
     (setq pt4
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt3
         pt1
       )
     )
     (setq normal (trans normal 1 0 T))
     (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 1 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 1 normal))
         (cons 10 (trans pt2 1 normal))
         (cons 10 (trans pt3 1 normal))
         (cons 10 (trans pt4 1 normal))
         (cons 210 normal)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

Many Thanks for it, i tried it. It partially work. I tried to use in many case but some time doesn't work.

 

Attached you can find the test. In three cases (red polyline) this lisp doesn't work. Maybe i make some mistake.

test.dwg

[marko_ribar]

Here, I've corrected Roy's code, although it's somewhat different, but logic is the same...

 

(defun c:3DRect ( / v^v unit doc normal pt1 pt2 pt3 pt4 )

 (vl-load-com)

 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
     (- (* (caddr u) (car v)) (* (car u) (caddr v)))
     (- (* (car u) (cadr v)) (* (cadr u) (car v)))
   )
 )

 (defun unit ( v )
   (if (not (equal v '(0.0 0.0 0.0) 1e-)
     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc) ; End open undo group.
 (vla-startundomark doc)
 (if
   (and
     (setq pt1 (trans (getpoint "\nFirst corner : ") 1 0))
     (setq pt3 (trans (getpoint (trans pt1 0 1) "\nOther corner : ") 1 0))
     (setq normal (unit (v^v '(0.0 0.0 1.0) (mapcar '- pt3 pt1))))
   )
   (progn
     (setq pt2 (inters pt1 (mapcar '+ pt1 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0)))) pt3 (mapcar '+ pt3 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0))) nil))
     (setq pt4 (inters pt3 (mapcar '+ pt3 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0)))) pt1 (mapcar '+ pt1 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0))) nil))
     (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 0 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 0 normal))
         (cons 10 (trans pt2 0 normal))
         (cons 10 (trans pt3 0 normal))
         (cons 10 (trans pt4 0 normal))
         (cons 210 normal)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

M.R.

[Roy_043]

My interpretation of the problem is different from Marko's. My code assumes the rectangle must be drawn parallel to the X, Y or Z plane of the current UCS. Marko's solution assumes that two sided of the rectangle must be parallel to the Z-axis of the WCS.

[Roy_043]

@Marko:

Why don't you calculate pt2 and pt4 like this?:

(setq pt2 (list (car pt1) (cadr pt1) (caddr pt3)))
(setq pt4 (list (car pt3) (cadr pt3) (caddr pt1)))

[marko_ribar]

@Marko:

Why don't you calculate pt2 and pt4 like this?:

(setq pt2 (list (car pt1) (cadr pt1) (caddr pt3)))
(setq pt4 (list (car pt3) (cadr pt3) (caddr pt1)))

 

Yes, it's simple as that... I over programmed the code, but result is the same - always many ways to skin the cat...