Jump to content

block points

mohammadreza

By mohammadreza
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mohammadreza Contributor

mohammadreza

Posted
Posted (edited)

hello everybody
how can i set 2 point for insert block
for example , for draw a door ask 2 point  and can return by mouse like this gif

door.gif

Edited by mohammadreza
Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

I am using these 2 routines that are doing this stuff during creation...

  

(defun c:dd ( / mid clockwise-p vl-position-fuzz osm p1 p2 di a1 a2 pp1 pp2 pp p311 p312 p321 p322 w p3 al ll gr aa pos ax k b ) ; *width* is global variable

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (defun clockwise-p ( p1 p2 p3 )
    (minusp (- (* (car (mapcar '- p3 p1)) (cadr (mapcar '- p2 p1))) (* (cadr (mapcar '- p3 p1)) (car (mapcar '- p2 p1)))))
  )

  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
    (defun car-vl-member-if ( f l / ff r )
      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
      (vl-some ff l)
      r
    )
    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  )

  (setq osm (getvar 'osmode))
  (initget 1)
  (setq p1 (getpoint "\nPick or specify first wall point : "))
  (initget 1)
  (setq p2 (getpoint p1 "\nPick or specify second wall point : "))
  (if (null *width*)
    (progn
      (initget 7)
      (setq w (getdist "\nPick or specify width of door panel : "))
    )
    (progn
      (initget 6)
      (setq w (getdist (strcat "\nPick or specify width of door panel <" (rtos *width* 2 8) "> : ")))
      (if (null w)
        (setq w *width*)
      )
    )
  )
  (setq *width* w)
  (setq di (distance p1 p2))
  (setq a1 (angle p1 p2))
  (setq a2 (angle p2 p1))
  (setq pp1 (polar (polar p1 a1 (/ di 2)) (+ a1 (* 0.5 pi)) (/ di 2)))
  (setq pp2 (polar (polar p1 a1 (/ di 2)) (- a1 (* 0.5 pi)) (/ di 2)))
  (grdraw p1 p2 1 1)
  (grdraw pp1 pp2 1 1)
  (setq p311 (polar p1 (+ a1 (* 0.5 pi)) di))
  (setq p312 (polar p1 (- a1 (* 0.5 pi)) di))
  (setq p321 (polar p2 (+ a2 (* 0.5 pi)) di))
  (setq p322 (polar p2 (- a2 (* 0.5 pi)) di))
  (grdraw (mid p1 p311) (mid p1 p312) 1 1)
  (grdraw (mid p2 p321) (mid p2 p322) 1 1)
  (grdraw (mid p1 p311) (mid p2 p322) 1 1)
  (grdraw (mid p1 p312) (mid p2 p321) 1 1)
  (setvar 'osmode 0)
  (initget 1)
  (setq pp (getpoint "\nPick or specify side point inside marked squares : "))
  (cond
    ( (and (not (inters p1 p2 pp (mid p1 p311))) (not (inters pp1 pp2 pp (mid p1 p311))))
      (setq p3 p311)
    )
    ( (and (not (inters p1 p2 pp (mid p1 p312))) (not (inters pp1 pp2 pp (mid p1 p312))))
      (setq p3 p312)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p321))) (not (inters pp1 pp2 pp (mid p2 p321))))
      (setq p3 p321)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p322))) (not (inters pp1 pp2 pp (mid p2 p322))))
      (setq p3 p322)
    )
  )
  (if (< (distance p3 p2) (distance p3 p1))
    (mapcar 'set '(p1 p2) (list p2 p1))
  )
  (setq al (mapcar '(lambda ( a ) (cvunit (rem (+ ((if (clockwise-p p1 p3 p2) - +) (cvunit (angle p1 p2) "radian" "degree") a) 360.0) 360.0) "degree" "radian")) (setq ll (list 0.0 (- 22.5 1e-8) (+ 22.5 1e-8) (- 45.0 1e-8) (+ 45.0 1e-8) (- 67.5 1e-8) (+ 67.5 1e-8) (- 90.0 1e-8) (+ 90.0 1e-8) (- 112.5 1e-8) (+ 112.5 1e-8) (- 135.0 1e-8) (+ 135.0 1e-8) (- 157.5 1e-8) (+ 157.5 1e-8) 180.0)))) 
  (while (= (car (setq gr (grread t))) 5)
    (redraw)
    (setq pp (cadr gr))
    (setq aa (angle p1 pp))
    (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
    (if (null pos)
      (progn
        (setq pp1 (trans pp 0 (mapcar '- p2 p1)))
        (setq pp2 (trans p1 0 (mapcar '- p2 p1)))
        (setq pp2 (list (car pp2) (cadr pp2) (caddr pp1)))
        (setq pp (trans (mapcar '+ pp2 (mapcar '- pp2 pp1)) (mapcar '- p2 p1) 0))
        (setq aa (angle p1 pp))
        (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
      )
    )
    (cond
      ( (or (= pos 1) (= pos 2))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.125 pi)) (* 2 pi)))
      )
      ( (or (= pos 3) (= pos 4))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.25 pi)) (* 2 pi)))
      )
      ( (or (= pos 5) (= pos 6))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.375 pi)) (* 2 pi)))
      )
      ( (or (= pos 7) (= pos 8))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.5 pi)) (* 2 pi)))
      )
      ( (or (= pos 9) (= pos 10))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.625 pi)) (* 2 pi)))
      )
      ( (or (= pos 11) (= pos 12))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.75 pi)) (* 2 pi)))
      )
      ( (or (= pos 13) (= pos 14))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.875 pi)) (* 2 pi)))
      )
      ( t
        (setq aa (nth pos al))
      )
    )
    (grdraw p1 (polar p1 aa di) 3 1)
    (setq ax (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 36) "degree" "radian"))
    (setq k -1)
    (repeat 36
      (setq pp1 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (setq k (1+ k)) ax)) di))
      (setq pp2 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (1+ k) ax)) di))
      (grdraw pp1 pp2 3 1)
    )
  )
  (setq b (/ (sin (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian")) (cos (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian"))))
  (setq p1 (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p2 (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p3 (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (cond
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 1.0) 1e-8)
      (setq aa (rem (+ aa (angle '(0 0) (getvar 'ucsxdir))) (* 2 pi)))
    )
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 -1.0) 1e-8)
      (setq aa (rem (- aa (angle '(0 0) (getvar 'ucsxdir)) pi) (* 2 pi)))
    )
  )
  (if (not (equal aa (angle p1 p2) 1e-6))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 2)
        (cons 70 (* 128 (getvar 'plinegen)))
        (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (polar p1 aa di))
        (cons 42 (if (clockwise-p p1 p3 p2) b (- b)))
        (cons 10 p2)
        (cons 42 0.0)
        (cons 62 253)
        (cons 8 "DOOR")
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 p1)
      (cons 42 0.0)
      (cons 10 (polar p1 aa di))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa di) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (prompt "\nWall opening that's picked is : ") (princ (rtos (distance p1 p2) 2 50))
  (redraw)
  (setvar 'osmode osm)
  (textscr)
  (princ)
)

  

(defun c:dw ( / mid clockwise-p vl-position-fuzz osm p1 p2 di a1 a2 pp1 pp2 pp p311 p312 p321 p322 w p3 al ll gr aa pos ax k b ) ; *width* is global variable

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (defun clockwise-p ( p1 p2 p3 )
    (minusp (- (* (car (mapcar '- p3 p1)) (cadr (mapcar '- p2 p1))) (* (cadr (mapcar '- p3 p1)) (car (mapcar '- p2 p1)))))
  )

  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
    (defun car-vl-member-if ( f l / ff r )
      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
      (vl-some ff l)
      r
    )
    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  )

  (setq osm (getvar 'osmode))
  (initget 1)
  (setq p1 (getpoint "\nPick or specify first wall point : "))
  (initget 1)
  (setq p2 (getpoint p1 "\nPick or specify second wall point : "))
  (if (null *width*)
    (progn
      (initget 7)
      (setq w (getdist "\nPick or specify width of door panel : "))
    )
    (progn
      (initget 6)
      (setq w (getdist (strcat "\nPick or specify width of door panel <" (rtos *width* 2 8) "> : ")))
      (if (null w)
        (setq w *width*)
      )
    )
  )
  (setq *width* w)
  (setq di (distance p1 p2))
  (setq a1 (angle p1 p2))
  (setq a2 (angle p2 p1))
  (setq pp1 (polar (polar p1 a1 (/ di 2)) (+ a1 (* 0.5 pi)) (/ di 2)))
  (setq pp2 (polar (polar p1 a1 (/ di 2)) (- a1 (* 0.5 pi)) (/ di 2)))
  (grdraw p1 p2 1 1)
  (grdraw pp1 pp2 1 1)
  (setq p311 (polar p1 (+ a1 (* 0.5 pi)) di))
  (setq p312 (polar p1 (- a1 (* 0.5 pi)) di))
  (setq p321 (polar p2 (+ a2 (* 0.5 pi)) di))
  (setq p322 (polar p2 (- a2 (* 0.5 pi)) di))
  (grdraw (mid p1 p311) (mid p1 p312) 1 1)
  (grdraw (mid p2 p321) (mid p2 p322) 1 1)
  (grdraw (mid p1 p311) (mid p2 p322) 1 1)
  (grdraw (mid p1 p312) (mid p2 p321) 1 1)
  (setvar 'osmode 0)
  (initget 1)
  (setq pp (getpoint "\nPick or specify side point inside marked squares : "))
  (cond
    ( (and (not (inters p1 p2 pp (mid p1 p311))) (not (inters pp1 pp2 pp (mid p1 p311))))
      (setq p3 p311)
    )
    ( (and (not (inters p1 p2 pp (mid p1 p312))) (not (inters pp1 pp2 pp (mid p1 p312))))
      (setq p3 p312)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p321))) (not (inters pp1 pp2 pp (mid p2 p321))))
      (setq p3 p321)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p322))) (not (inters pp1 pp2 pp (mid p2 p322))))
      (setq p3 p322)
    )
  )
  (if (< (distance p3 p2) (distance p3 p1))
    (mapcar 'set '(p1 p2) (list p2 p1))
  )
  (setq al (mapcar '(lambda ( a ) (cvunit (rem (+ ((if (clockwise-p p1 p3 p2) - +) (cvunit (angle p1 p2) "radian" "degree") a) 360.0) 360.0) "degree" "radian")) (setq ll (list 0.0 (- 22.5 1e-8) (+ 22.5 1e-8) (- 45.0 1e-8) (+ 45.0 1e-8) (- 67.5 1e-8) (+ 67.5 1e-8) (- 90.0 1e-8) (+ 90.0 1e-8) (- 112.5 1e-8) (+ 112.5 1e-8) (- 135.0 1e-8) (+ 135.0 1e-8) (- 157.5 1e-8) (+ 157.5 1e-8) 180.0)))) 
  (while (= (car (setq gr (grread t))) 5)
    (redraw)
    (setq pp (cadr gr))
    (setq aa (angle p1 pp))
    (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
    (if (null pos)
      (progn
        (setq pp1 (trans pp 0 (mapcar '- p2 p1)))
        (setq pp2 (trans p1 0 (mapcar '- p2 p1)))
        (setq pp2 (list (car pp2) (cadr pp2) (caddr pp1)))
        (setq pp (trans (mapcar '+ pp2 (mapcar '- pp2 pp1)) (mapcar '- p2 p1) 0))
        (setq aa (angle p1 pp))
        (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
      )
    )
    (cond
      ( (or (= pos 1) (= pos 2))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.125 pi)) (* 2 pi)))
      )
      ( (or (= pos 3) (= pos 4))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.25 pi)) (* 2 pi)))
      )
      ( (or (= pos 5) (= pos 6))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.375 pi)) (* 2 pi)))
      )
      ( (or (= pos 7) (= pos 8))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.5 pi)) (* 2 pi)))
      )
      ( (or (= pos 9) (= pos 10))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.625 pi)) (* 2 pi)))
      )
      ( (or (= pos 11) (= pos 12))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.75 pi)) (* 2 pi)))
      )
      ( (or (= pos 13) (= pos 14))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.875 pi)) (* 2 pi)))
      )
      ( t
        (setq aa (nth pos al))
      )
    )
    (grdraw p1 (polar p1 aa di) 3 1)
    (setq ax (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 36) "degree" "radian"))
    (setq k -1)
    (repeat 36
      (setq pp1 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (setq k (1+ k)) ax)) di))
      (setq pp2 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (1+ k) ax)) di))
      (grdraw pp1 pp2 3 1)
    )
  )
  (setq b (/ (sin (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian")) (cos (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian"))))
  (setq p1 (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p2 (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p3 (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (cond
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 1.0) 1e-8)
      (setq aa (rem (+ aa (angle '(0 0) (getvar 'ucsxdir))) (* 2 pi)))
    )
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 -1.0) 1e-8)
      (setq aa (rem (- aa (angle '(0 0) (getvar 'ucsxdir)) pi) (* 2 pi)))
    )
  )
  (if (not (equal aa (angle p1 p2) 1e-6))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 2)
        (cons 70 (* 128 (getvar 'plinegen)))
        (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (polar p1 aa di))
        (cons 42 (if (clockwise-p p1 p3 p2) b (- b)))
        (cons 10 p2)
        (cons 42 0.0)
        (cons 62 253)
        (cons 8 "DOOR")
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 p1)
      (cons 42 0.0)
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa di))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa di) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 62 4)
      (cons 8 "DOOR")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (prompt "\nWall opening that's picked is : ") (princ (rtos (distance p1 p2) 2 50))
  (prompt "\nClear glass length is : ") (princ (rtos (distance (polar p1 (angle p1 p2) (* w 1.5)) (polar p2 (angle p2 p1) (* w 1.5))) 2 50))
  (redraw)
  (setvar 'osmode osm)
  (textscr)
  (princ)
)

 

HTH.

M.R.

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

And this is what I use for windows...

  

(defun c:ww ( / mid clockwise-p vl-position-fuzz osm p1 p2 ch di a1 a2 pp1 pp2 pp p311 p312 p321 p322 w p3 al ll gr aa pos ax k b ) ; *width* is global variable

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (defun clockwise-p ( p1 p2 p3 )
    (minusp (- (* (car (mapcar '- p3 p1)) (cadr (mapcar '- p2 p1))) (* (cadr (mapcar '- p3 p1)) (car (mapcar '- p2 p1)))))
  )

  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
    (defun car-vl-member-if ( f l / ff r )
      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
      (vl-some ff l)
      r
    )
    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  )

  (setq osm (getvar 'osmode))
  (initget 1)
  (setq p1 (getpoint "\nPick or specify first wall point : "))
  (initget 1)
  (setq p2 (getpoint p1 "\nPick or specify second wall point : "))
  (initget "Yes No")
  (setq ch (getkword "\nDo you want to displace opening for static frame [Yes/No] <Yes> : "))
  (if (null ch)
    (setq ch "Yes")
  )
  (if (null *width*)
    (progn
      (initget 7)
      (setq w (getdist "\nPick or specify width of window panel : "))
    )
    (progn
      (initget 6)
      (setq w (getdist (strcat "\nPick or specify width of window panel <" (rtos *width* 2 8) "> : ")))
      (if (null w)
        (setq w *width*)
      )
    )
  )
  (setq *width* w)
  (if (= ch "Yes")
    (progn
      (setq p1 (polar p1 (angle p1 p2) w))
      (setq p2 (polar p2 (angle p2 p1) w))
    )
  )
  (setq di (distance p1 p2))
  (setq a1 (angle p1 p2))
  (setq a2 (angle p2 p1))
  (setq pp1 (polar (polar p1 a1 (/ di 2)) (+ a1 (* 0.5 pi)) (/ di 2)))
  (setq pp2 (polar (polar p1 a1 (/ di 2)) (- a1 (* 0.5 pi)) (/ di 2)))
  (grdraw p1 p2 1 1)
  (grdraw pp1 pp2 1 1)
  (setq p311 (polar p1 (+ a1 (* 0.5 pi)) di))
  (setq p312 (polar p1 (- a1 (* 0.5 pi)) di))
  (setq p321 (polar p2 (+ a2 (* 0.5 pi)) di))
  (setq p322 (polar p2 (- a2 (* 0.5 pi)) di))
  (grdraw (mid p1 p311) (mid p1 p312) 1 1)
  (grdraw (mid p2 p321) (mid p2 p322) 1 1)
  (grdraw (mid p1 p311) (mid p2 p322) 1 1)
  (grdraw (mid p1 p312) (mid p2 p321) 1 1)
  (setvar 'osmode 0)
  (initget 1)
  (setq pp (getpoint "\nPick or specify side point inside marked squares : "))
  (cond
    ( (and (not (inters p1 p2 pp (mid p1 p311))) (not (inters pp1 pp2 pp (mid p1 p311))))
      (setq p3 p311)
    )
    ( (and (not (inters p1 p2 pp (mid p1 p312))) (not (inters pp1 pp2 pp (mid p1 p312))))
      (setq p3 p312)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p321))) (not (inters pp1 pp2 pp (mid p2 p321))))
      (setq p3 p321)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p322))) (not (inters pp1 pp2 pp (mid p2 p322))))
      (setq p3 p322)
    )
  )
  (if (< (distance p3 p2) (distance p3 p1))
    (mapcar 'set '(p1 p2) (list p2 p1))
  )
  (setq al (mapcar '(lambda ( a ) (cvunit (rem (+ ((if (clockwise-p p1 p3 p2) - +) (cvunit (angle p1 p2) "radian" "degree") a) 360.0) 360.0) "degree" "radian")) (setq ll (list 0.0 (- 22.5 1e-8) (+ 22.5 1e-8) (- 45.0 1e-8) (+ 45.0 1e-8) (- 67.5 1e-8) (+ 67.5 1e-8) (- 90.0 1e-8) (+ 90.0 1e-8) (- 112.5 1e-8) (+ 112.5 1e-8) (- 135.0 1e-8) (+ 135.0 1e-8) (- 157.5 1e-8) (+ 157.5 1e-8) 180.0)))) 
  (while (= (car (setq gr (grread t))) 5)
    (redraw)
    (setq pp (cadr gr))
    (setq aa (angle p1 pp))
    (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
    (if (null pos)
      (progn
        (setq pp1 (trans pp 0 (mapcar '- p2 p1)))
        (setq pp2 (trans p1 0 (mapcar '- p2 p1)))
        (setq pp2 (list (car pp2) (cadr pp2) (caddr pp1)))
        (setq pp (trans (mapcar '+ pp2 (mapcar '- pp2 pp1)) (mapcar '- p2 p1) 0))
        (setq aa (angle p1 pp))
        (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
      )
    )
    (cond
      ( (or (= pos 1) (= pos 2))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.125 pi)) (* 2 pi)))
      )
      ( (or (= pos 3) (= pos 4))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.25 pi)) (* 2 pi)))
      )
      ( (or (= pos 5) (= pos 6))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.375 pi)) (* 2 pi)))
      )
      ( (or (= pos 7) (= pos 8))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.5 pi)) (* 2 pi)))
      )
      ( (or (= pos 9) (= pos 10))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.625 pi)) (* 2 pi)))
      )
      ( (or (= pos 11) (= pos 12))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.75 pi)) (* 2 pi)))
      )
      ( (or (= pos 13) (= pos 14))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.875 pi)) (* 2 pi)))
      )
      ( t
        (setq aa (nth pos al))
      )
    )
    (grdraw p1 (polar p1 aa di) 3 1)
    (setq ax (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 36) "degree" "radian"))
    (setq k -1)
    (repeat 36
      (setq pp1 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (setq k (1+ k)) ax)) di))
      (setq pp2 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (1+ k) ax)) di))
      (grdraw pp1 pp2 3 1)
    )
  )
  (setq b (/ (sin (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian")) (cos (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian"))))
  (setq p1 (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p2 (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p3 (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (cond
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 1.0) 1e-8)
      (setq aa (rem (+ aa (angle '(0 0) (getvar 'ucsxdir))) (* 2 pi)))
    )
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 -1.0) 1e-8)
      (setq aa (rem (- aa (angle '(0 0) (getvar 'ucsxdir)) pi) (* 2 pi)))
    )
  )
  (if (not (equal aa (angle p1 p2) 1e-6))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 2)
        (cons 70 (* 128 (getvar 'plinegen)))
        (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (polar p1 aa di))
        (cons 42 (if (clockwise-p p1 p3 p2) b (- b)))
        (cons 10 p2)
        (cons 42 0.0)
        (cons 62 253)
        (cons 8 "WINDOW")
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 p1)
      (cons 42 0.0)
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa di))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa di) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 62 4)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (if (= ch "Yes")
    (progn
      (entmake
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 (1+ (* 128 (getvar 'plinegen))))
          (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
          (cons 10 (polar p1 (angle p2 p1) w))
          (cons 42 0.0)
          (cons 10 p1)
          (cons 42 0.0)
          (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 10 (polar (polar p1 (angle p2 p1) w) ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 8 "WINDOW")
          (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
        )
      )
      (entmake
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 (1+ (* 128 (getvar 'plinegen))))
          (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
          (cons 10 (polar p2 (angle p1 p2) w))
          (cons 42 0.0)
          (cons 10 p2)
          (cons 42 0.0)
          (cons 10 (polar p2 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 10 (polar (polar p2 (angle p1 p2) w) ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 8 "WINDOW")
          (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
        )
      )
      (if (not (equal (angle p1 p2) aa 1e-6))
        (progn
          (entmake
            (list
              (cons 0 "LWPOLYLINE")
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbPolyline")
              (cons 90 2)
              (cons 70 (* 128 (getvar 'plinegen)))
              (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
              (cons 10 p1)
              (cons 42 0.0)
              (cons 10 p2)
              (cons 42 0.0)
              (cons 62 252)
              (cons 8 "WINDOW")
              (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
            )
          )
          (entmake
            (list
              (cons 0 "LWPOLYLINE")
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbPolyline")
              (cons 90 2)
              (cons 70 (* 128 (getvar 'plinegen)))
              (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
              (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
              (cons 42 0.0)
              (cons 10 (polar p2 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
              (cons 42 0.0)
              (cons 62 252)
              (cons 8 "WINDOW")
              (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
            )
          )
        )
      )
      (prompt "\nWall opening that's picked is : ") (princ (rtos (distance (polar p1 (angle p2 p1) w) (polar p2 (angle p1 p2) w)) 2 50))
      (prompt "\nClear glass length is : ") (princ (rtos (distance (polar p1 (angle p1 p2) (* w 1.5)) (polar p2 (angle p2 p1) (* w 1.5))) 2 50))
    )
  )
  (if (= ch "No")
    (progn
      (prompt "\nWall opening that's picked is : ") (princ (rtos (distance p1 p2) 2 50))
      (prompt "\nClear glass length is : ") (princ (rtos (distance (polar p1 (angle p1 p2) (* w 1.5)) (polar p2 (angle p2 p1) (* w 1.5))) 2 50))
    )
  )
  (redraw)
  (setvar 'osmode osm)
  (textscr)
  (princ)
)

 

Regards, M.R.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Similar approach but a big package yes a cost. Enter sizes and drawn. Doors need to be added plus roofs etc. Currently trying to convert to imperial. Yes asks for offsets from corner then width, in out, left or right swing.

 

image.thumb.png.10eeb4611d81de8d337456fd68694731.png

 

 

Link to comment
Share on other sites
mohammadreza Contributor

mohammadreza

Posted
  • Author
Posted
On 11/9/2023 at 8:31 PM, marko_ribar said:

And this is what I use for windows...

  

(defun c:ww ( / mid clockwise-p vl-position-fuzz osm p1 p2 ch di a1 a2 pp1 pp2 pp p311 p312 p321 p322 w p3 al ll gr aa pos ax k b ) ; *width* is global variable

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  (defun clockwise-p ( p1 p2 p3 )
    (minusp (- (* (car (mapcar '- p3 p1)) (cadr (mapcar '- p2 p1))) (* (cadr (mapcar '- p3 p1)) (car (mapcar '- p2 p1)))))
  )

  (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
    (defun car-vl-member-if ( f l / ff r )
      (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
      (vl-some ff l)
      r
    )
    (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  )

  (setq osm (getvar 'osmode))
  (initget 1)
  (setq p1 (getpoint "\nPick or specify first wall point : "))
  (initget 1)
  (setq p2 (getpoint p1 "\nPick or specify second wall point : "))
  (initget "Yes No")
  (setq ch (getkword "\nDo you want to displace opening for static frame [Yes/No] <Yes> : "))
  (if (null ch)
    (setq ch "Yes")
  )
  (if (null *width*)
    (progn
      (initget 7)
      (setq w (getdist "\nPick or specify width of window panel : "))
    )
    (progn
      (initget 6)
      (setq w (getdist (strcat "\nPick or specify width of window panel <" (rtos *width* 2 8) "> : ")))
      (if (null w)
        (setq w *width*)
      )
    )
  )
  (setq *width* w)
  (if (= ch "Yes")
    (progn
      (setq p1 (polar p1 (angle p1 p2) w))
      (setq p2 (polar p2 (angle p2 p1) w))
    )
  )
  (setq di (distance p1 p2))
  (setq a1 (angle p1 p2))
  (setq a2 (angle p2 p1))
  (setq pp1 (polar (polar p1 a1 (/ di 2)) (+ a1 (* 0.5 pi)) (/ di 2)))
  (setq pp2 (polar (polar p1 a1 (/ di 2)) (- a1 (* 0.5 pi)) (/ di 2)))
  (grdraw p1 p2 1 1)
  (grdraw pp1 pp2 1 1)
  (setq p311 (polar p1 (+ a1 (* 0.5 pi)) di))
  (setq p312 (polar p1 (- a1 (* 0.5 pi)) di))
  (setq p321 (polar p2 (+ a2 (* 0.5 pi)) di))
  (setq p322 (polar p2 (- a2 (* 0.5 pi)) di))
  (grdraw (mid p1 p311) (mid p1 p312) 1 1)
  (grdraw (mid p2 p321) (mid p2 p322) 1 1)
  (grdraw (mid p1 p311) (mid p2 p322) 1 1)
  (grdraw (mid p1 p312) (mid p2 p321) 1 1)
  (setvar 'osmode 0)
  (initget 1)
  (setq pp (getpoint "\nPick or specify side point inside marked squares : "))
  (cond
    ( (and (not (inters p1 p2 pp (mid p1 p311))) (not (inters pp1 pp2 pp (mid p1 p311))))
      (setq p3 p311)
    )
    ( (and (not (inters p1 p2 pp (mid p1 p312))) (not (inters pp1 pp2 pp (mid p1 p312))))
      (setq p3 p312)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p321))) (not (inters pp1 pp2 pp (mid p2 p321))))
      (setq p3 p321)
    )
    ( (and (not (inters p1 p2 pp (mid p2 p322))) (not (inters pp1 pp2 pp (mid p2 p322))))
      (setq p3 p322)
    )
  )
  (if (< (distance p3 p2) (distance p3 p1))
    (mapcar 'set '(p1 p2) (list p2 p1))
  )
  (setq al (mapcar '(lambda ( a ) (cvunit (rem (+ ((if (clockwise-p p1 p3 p2) - +) (cvunit (angle p1 p2) "radian" "degree") a) 360.0) 360.0) "degree" "radian")) (setq ll (list 0.0 (- 22.5 1e-8) (+ 22.5 1e-8) (- 45.0 1e-8) (+ 45.0 1e-8) (- 67.5 1e-8) (+ 67.5 1e-8) (- 90.0 1e-8) (+ 90.0 1e-8) (- 112.5 1e-8) (+ 112.5 1e-8) (- 135.0 1e-8) (+ 135.0 1e-8) (- 157.5 1e-8) (+ 157.5 1e-8) 180.0)))) 
  (while (= (car (setq gr (grread t))) 5)
    (redraw)
    (setq pp (cadr gr))
    (setq aa (angle p1 pp))
    (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
    (if (null pos)
      (progn
        (setq pp1 (trans pp 0 (mapcar '- p2 p1)))
        (setq pp2 (trans p1 0 (mapcar '- p2 p1)))
        (setq pp2 (list (car pp2) (cadr pp2) (caddr pp1)))
        (setq pp (trans (mapcar '+ pp2 (mapcar '- pp2 pp1)) (mapcar '- p2 p1) 0))
        (setq aa (angle p1 pp))
        (setq pos (vl-position-fuzz aa al (cvunit 22.5 "degree" "radian")))
      )
    )
    (cond
      ( (or (= pos 1) (= pos 2))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.125 pi)) (* 2 pi)))
      )
      ( (or (= pos 3) (= pos 4))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.25 pi)) (* 2 pi)))
      )
      ( (or (= pos 5) (= pos 6))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.375 pi)) (* 2 pi)))
      )
      ( (or (= pos 7) (= pos 8))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.5 pi)) (* 2 pi)))
      )
      ( (or (= pos 9) (= pos 10))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.625 pi)) (* 2 pi)))
      )
      ( (or (= pos 11) (= pos 12))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.75 pi)) (* 2 pi)))
      )
      ( (or (= pos 13) (= pos 14))
        (setq aa (rem ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* 0.875 pi)) (* 2 pi)))
      )
      ( t
        (setq aa (nth pos al))
      )
    )
    (grdraw p1 (polar p1 aa di) 3 1)
    (setq ax (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 36) "degree" "radian"))
    (setq k -1)
    (repeat 36
      (setq pp1 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (setq k (1+ k)) ax)) di))
      (setq pp2 (polar p1 ((if (clockwise-p p1 p3 p2) - +) (angle p1 p2) (* (1+ k) ax)) di))
      (grdraw pp1 pp2 3 1)
    )
  )
  (setq b (/ (sin (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian")) (cos (cvunit (/ (cond ( (or (= pos 1) (= pos 2)) 22.5) ( (or (= pos 3) (= pos 4)) 45.0) ( (or (= pos 5) (= pos 6)) 67.5) ( (or (= pos 7) (= pos 8)) 90.0) ( (or (= pos 9) (= pos 10)) 112.5) ( (or (= pos 11) (= pos 12)) 135.0) ( (or (= pos 13) (= pos 14)) 157.5) ( t (nth pos ll))) 4.0) "degree" "radian"))))
  (setq p1 (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p2 (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (setq p3 (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t)))
  (cond
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 1.0) 1e-8)
      (setq aa (rem (+ aa (angle '(0 0) (getvar 'ucsxdir))) (* 2 pi)))
    )
    ( (equal (trans '(0.0 0.0 1.0) 1 0 t) '(0.0 0.0 -1.0) 1e-8)
      (setq aa (rem (- aa (angle '(0 0) (getvar 'ucsxdir)) pi) (* 2 pi)))
    )
  )
  (if (not (equal aa (angle p1 p2) 1e-6))
    (entmake
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 2)
        (cons 70 (* 128 (getvar 'plinegen)))
        (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (polar p1 aa di))
        (cons 42 (if (clockwise-p p1 p3 p2) b (- b)))
        (cons 10 p2)
        (cons 42 0.0)
        (cons 62 253)
        (cons 8 "WINDOW")
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 2)
      (cons 70 (* 128 (getvar 'plinegen)))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w) aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 62 252)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 p1)
      (cons 42 0.0)
      (cons 10 (polar p1 aa (* w 1.5)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (* w 1.5)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 8)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar p1 aa di))
      (cons 42 0.0)
      (cons 10 (polar p1 aa (- di (* w 1.5))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di (* w 1.5))) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa di) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) w))
      (cons 42 0.0)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (/ w 3)))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa (- di w)) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 10 (polar (polar p1 aa w) ((if (clockwise-p p1 p3 p2) + -) aa (* 0.5 pi)) (* 2 (/ w 3))))
      (cons 42 0.0)
      (cons 62 4)
      (cons 8 "WINDOW")
      (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
    )
  )
  (if (= ch "Yes")
    (progn
      (entmake
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 (1+ (* 128 (getvar 'plinegen))))
          (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
          (cons 10 (polar p1 (angle p2 p1) w))
          (cons 42 0.0)
          (cons 10 p1)
          (cons 42 0.0)
          (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 10 (polar (polar p1 (angle p2 p1) w) ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 8 "WINDOW")
          (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
        )
      )
      (entmake
        (list
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 4)
          (cons 70 (1+ (* 128 (getvar 'plinegen))))
          (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
          (cons 10 (polar p2 (angle p1 p2) w))
          (cons 42 0.0)
          (cons 10 p2)
          (cons 42 0.0)
          (cons 10 (polar p2 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 10 (polar (polar p2 (angle p1 p2) w) ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
          (cons 42 0.0)
          (cons 8 "WINDOW")
          (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
        )
      )
      (if (not (equal (angle p1 p2) aa 1e-6))
        (progn
          (entmake
            (list
              (cons 0 "LWPOLYLINE")
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbPolyline")
              (cons 90 2)
              (cons 70 (* 128 (getvar 'plinegen)))
              (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
              (cons 10 p1)
              (cons 42 0.0)
              (cons 10 p2)
              (cons 42 0.0)
              (cons 62 252)
              (cons 8 "WINDOW")
              (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
            )
          )
          (entmake
            (list
              (cons 0 "LWPOLYLINE")
              (cons 100 "AcDbEntity")
              (cons 100 "AcDbPolyline")
              (cons 90 2)
              (cons 70 (* 128 (getvar 'plinegen)))
              (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
              (cons 10 (polar p1 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
              (cons 42 0.0)
              (cons 10 (polar p2 ((if (clockwise-p p1 p3 p2) + -) (angle p1 p2) (* 0.5 pi)) w))
              (cons 42 0.0)
              (cons 62 252)
              (cons 8 "WINDOW")
              (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
            )
          )
        )
      )
      (prompt "\nWall opening that's picked is : ") (princ (rtos (distance (polar p1 (angle p2 p1) w) (polar p2 (angle p1 p2) w)) 2 50))
      (prompt "\nClear glass length is : ") (princ (rtos (distance (polar p1 (angle p1 p2) (* w 1.5)) (polar p2 (angle p2 p1) (* w 1.5))) 2 50))
    )
  )
  (if (= ch "No")
    (progn
      (prompt "\nWall opening that's picked is : ") (princ (rtos (distance p1 p2) 2 50))
      (prompt "\nClear glass length is : ") (princ (rtos (distance (polar p1 (angle p1 p2) (* w 1.5)) (polar p2 (angle p2 p1) (* w 1.5))) 2 50))
    )
  )
  (redraw)
  (setvar 'osmode osm)
  (textscr)
  (princ)
)

 

Regards, M.R.

hi
do you have that door(2d) lisp ?

like that i sent as gif ?

 

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

No, I don't have, but you can pull out from routines 4 quadrants from different orient angle and use (grread) position of cursor function inside (while) loop to scale block in X direction to 1 and -1 (meaning mirror) and the same with Y direction...

Edited by marko_ribar
Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Check out download section for newly added dd.lsp dw.lsp ww.lsp and blockflips.lsp ... Now dd, dw and ww are blocks with insertion point in the middle of p1 and p2...

 

[EDIT : It's not ab x and y scalefactors 1.0 and -1.0 like I was suspecting, but performing MIRROR command more times...]

 

Here is the code for flipping blocks :

  

(defun c:blockflips ( / *error* osm cmd s gr p el bl0 bl1 bl2 bl3 )

  (vl-load-com)

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar 'undoctl)))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if osm (setvar 'osmode osm))
    (if cmd (setvar 'cmdecho cmd))
    (if m (prompt m))
    (princ)
  )

  (alert "Place block insertion point on place that differs from WCS origin 0,0,0 (alignment must be different than WCS - moved or rotated)...")
  (vl-cmdf "_.UCS" "_W")
  (if (setq osm (getvar 'osmode)) (setvar 'osmode 0))
  (if (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vl-cmdf "_.UNDO" "_E")
  )
  (vl-cmdf "_.UNDO" "_BE")
  (prompt "\nPick block for flipping...")
  (if (setq s (ssget "_+.:E:S:L" '((0 . "INSERT"))))
    (progn
      (setq bl0 (ssname s 0))
      (while (= 1 (getvar 'worlducs))
        (vl-cmdf "_.UCS" "_E" (cadr (grread t)))
        (entupd bl0)
      )
      (setq el (entlast))
      (repeat 3
        (vl-cmdf "_.COPY" bl0 "" "_non" (list 0.0 0.0 0.0) "_non" (list 0.0 0.0 0.0))
      )
      (setq el (entnext el))
      (vl-cmdf "_.MIRROR" el "" "_non" (list 0.0 0.0 0.0) "_non" (list 0.0 1.0 0.0) "_Y")
      (setq bl1 el)
      (setq el (entnext el))
      (vl-cmdf "_.MIRROR" el "" "_non" (list 1.0 0.0 0.0) "_non" (list 0.0 0.0 0.0) "_Y")
      (setq bl2 el)
      (setq el (entnext el))
      (vl-cmdf "_.MIRROR" el "" "_non" (list 0.0 0.0 0.0) "_non" (list 0.0 1.0 0.0) "_Y")   
      (vl-cmdf "_.MIRROR" el "" "_non" (list 1.0 0.0 0.0) "_non" (list 0.0 0.0 0.0) "_Y")
      (setq bl3 el)
      (if (= (getvar 'program) "BRICSCAD")
        (progn
          (setq s (ssadd))
          (ssadd bl1 s)
          (ssadd bl2 s)
          (ssadd bl3 s)
          (vl-cmdf "_.HIDEOBJECTS" s "")
        )
        (progn
          (redraw bl0 1)
          (redraw bl1 2)
          (redraw bl2 2)
          (redraw bl3 2)
        )
      )
      (prompt "\nPress any key from keyboard or right mouse click to finish...")
      (while (vl-position (car (setq gr (grread t))) (list 3 5))
        (if (and (listp (setq p (cadr gr))) (= (length p) 3) (vl-every 'numberp p))
          (cond
            ( (and (> (car p) 0.0) (> (cadr p) 0.0))
              (if (= (getvar 'program) "BRICSCAD")
                (progn
                  (vl-cmdf "_.UNISOLATEOBJECTS")
                  (setq s (ssadd))
                  (ssadd bl1 s)
                  (ssadd bl2 s)
                  (ssadd bl3 s)
                  (vl-cmdf "_.HIDEOBJECTS" s "")
                )
                (progn
                  (redraw bl0 1)
                  (redraw bl1 2)
                  (redraw bl2 2)
                  (redraw bl3 2)
                )
              )
            )
            ( (and (< (car p) 0.0) (> (cadr p) 0.0))
              (if (= (getvar 'program) "BRICSCAD")
                (progn
                  (vl-cmdf "_.UNISOLATEOBJECTS")
                  (setq s (ssadd))
                  (ssadd bl0 s)
                  (ssadd bl2 s)
                  (ssadd bl3 s)
                  (vl-cmdf "_.HIDEOBJECTS" s "")
                )
                (progn
                  (redraw bl0 2)
                  (redraw bl1 1)
                  (redraw bl2 2)
                  (redraw bl3 2)
                )
              )
            )
            ( (and (< (car p) 0.0) (< (cadr p) 0.0))
              (if (= (getvar 'program) "BRICSCAD")
                (progn
                  (vl-cmdf "_.UNISOLATEOBJECTS")
                  (setq s (ssadd))
                  (ssadd bl0 s)
                  (ssadd bl1 s)
                  (ssadd bl2 s)
                  (vl-cmdf "_.HIDEOBJECTS" s "")
                )
                (progn
                  (redraw bl0 2)
                  (redraw bl1 2)
                  (redraw bl2 2)
                  (redraw bl3 1)
                )
              )
            )
            ( (and (> (car p) 0.0) (< (cadr p) 0.0))
              (if (= (getvar 'program) "BRICSCAD")
                (progn
                  (vl-cmdf "_.UNISOLATEOBJECTS")
                  (setq s (ssadd))
                  (ssadd bl0 s)
                  (ssadd bl1 s)
                  (ssadd bl3 s)
                  (vl-cmdf "_.HIDEOBJECTS" s "")
                )
                (progn
                  (redraw bl0 2)
                  (redraw bl1 2)
                  (redraw bl2 1)
                  (redraw bl3 2)
                )
              )
            )
          )
        )
      )
      (cond
        ( (and (> (car p) 0.0) (> (cadr p) 0.0))
          (entdel bl1)
          (entdel bl2)
          (entdel bl3)
        )
        ( (and (< (car p) 0.0) (> (cadr p) 0.0))
          (entdel bl0)
          (entdel bl2)
          (entdel bl3)
        )
        ( (and (< (car p) 0.0) (< (cadr p) 0.0))
          (entdel bl0)
          (entdel bl1)
          (entdel bl2)
        )
        ( (and (> (car p) 0.0) (< (cadr p) 0.0))
          (entdel bl0)
          (entdel bl1)
          (entdel bl3)
        )
      )
    )
  )
  (vl-cmdf "_.UCS" "_P")
  (*error* nil)
)

 

HTH.

M.R.

Edited by marko_ribar
Link to comment
Share on other sites

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...