single door Lisp......... again!

[Anonymous]

Hi,

I know this has been done to death, sorry. Just searched and it came up with 7+ pages! However, a cheeky one if anyone doesn't mind. Perhaps a 10 minute task for those who know how? :-).

With CAD speed all about reducing key-strokes I reckon (hope) to reduce a door insertion from 30 key-strokes to 4 key strokes with a Lisp.

Aim

Creates a 2D Polyline of width 15mm at 90degs to the wall opening, of length as per the opening, with an arc from end of the line to the end of the opening. All on layer 'door'. Leaving door opening itself, clear.

Aim for operator use:

- 'd'

- 'start point?'

- 'end point?'

- 'side?'

If I explain the current operations, in full, then you will see what I am aiming to automate:

- F8 (ortho off)

- C (circle)

- click start of door opening

- click end of door door opening

- SN (snap-angle)

- click start of door opening

- click end of door door opening

- F8 (ortho on)

- PL (Polyline)

- click start of door opening

- click to door opener side past circle circumference (90 degs)

- T (trim)

- select newly created PL, circle and bounding line currently at the end point of the opening

- select all parts to be trimmed (end of PL) and three-quarters of the circle

- click PL

- change it's global width to 0.015 (units are already set to be metres)

- click the arc (as well as the PL)

- change both elements to layer 'Door'

I think that's it. Simple in operation but lengthy. I know that there is a better solution.

Many thanks in advance. I accept that I may be told to 'go off and learn Lisp' but, worth a try.

Thanks.

R

PS - Another one simple one. Completely different if I may ...... 🙂

Operator aim:

- press 'K'

- initiates the 3DORBITERCTR command with the snap to NOD

Currently, I have to every time, press 'k' (why 'k' I don't know) and then 'n', 'o', 'd', enter. It seems silly to have to do this EVERY time.

Thanks.

R

[marko_ribar]

Haven't looked at the picture, but I believe you are right... I've mod. my dd.lsp long time ago as I noticed the issue and haven't posted revision as I couldn't find this topic and I thought it's just simple mod. that anyone can do...

Here, try this from my library :

(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 😎 "> : ")))
      (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"))))
  (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 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")
      )
    )
  )
  (entmake
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 (1+ (* 128 (getvar 'plinegen))))
      (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")
    )
  )
  (prompt "\nWall opening that's picked is : ") (princ (rtos (distance p1 p2) 2 50))
  (redraw)
  (setvar 'osmode osm)
  (textscr)
  (princ)
)

HTH.

[OM805]

Marko,

I get the following error message. Further assistance would be greatly appreciated. 

error: malformed list on input

Regards,

OM

[marko_ribar]

Well, you have wrongly copy+pasted the code I posted... I'll see to attach dd.lsp file...

[OM805]

Marko,

Tried copy/pasting the original code a few times...  Regardless, the final lsp file code is working out on my end.  Thank you for all of your help. Much appreciated...

Regards,

OM