0 Members and 1 Guest are viewing this topic.
(defun c:sr (/ pl osn opm opa oas ip u30 cd cp1 p1 p2 p3 u u1 u2 u3 u4 ip1 p21 ip2 p22 oerr ) (setq osn (getvar "osmode") opm (getvar "polarmode") opa (getvar "polarang") oas (getvar "autosnap") ) (setq oerr *error*) (defun *error* (msg) (princ "\n ERROR! <p>") (setvar "osmode" osn) (setvar "polarmode" opm) (setvar "polarang" opa) (setvar "autosnap" oas) (setq *error* oerr) (command) (princ) ) (command "_.undo" "begin") (initget "Right Left Top") (if pll () (setq pll "Right") ) (princ "\n Choose plane: Right, Left, Top >> ") (princ pll) (princ " <<: ") (setq pl (getkword)) (if (= pl nil) (setq pl pll) (setq pll pl) ) (setvar "autosnap" 63) (setvar "polarmode" 7) (setvar "polarang" (/ (* 30 pi) 180)) (setq ip (getpoint "\n First corner: ") p2 (getpoint ip "\n Opposite corner: ") );;;**************** (cond ((= pl "Right") (if (< (car ip) (car p2)) (setq u30 (/ pi 6.0)) (setq u30 (+ pi (/ pi 6.0))) ) (setq cd (- (car p2) (car ip)) cp1 (polar ip 0 cd) p1 (polar cp1 (* pi 0.5) (* (/ (sin u30) (cos u30)) cd)) p3 (polar p2 (angle p1 ip) (distance p1 ip)) ) );;;**************** ((= pl "Left") (if (< (car ip) (car p2)) (setq u30 (* -1 (/ pi 6.0))) (setq u30 (* -1 (+ pi (/ pi 6.0)))) ) (setq cd (- (car p2) (car ip)) cp1 (polar ip 0 cd) p1 (polar cp1 (* pi 0.5) (* (/ (sin u30) (cos u30)) cd)) p3 (polar p2 (angle p1 ip) (distance p1 ip)) ) );;;*************** ((= pl "Top") (setq u (angle ip p2) u1 (/ pi 6) u2 (* u1 5) u3 (* u1 7) u4 (* u1 11) ) (cond ((or (> u u4) (< u u1)) (setq ip1 (polar ip u4 1.) p21 (polar p2 u3 1.) p22 (polar p2 u2 1.) ip2 (polar ip u1 1.) ) ) ((> u4 u u3) (setq ip1 (polar ip u3 1.) p21 (polar p2 u2 1.) p22 (polar p2 u1 1.) ip2 (polar ip u4 1.) ) ) ((> u3 u u2) (setq ip1 (polar ip u2 1.) p21 (polar p2 u1 1.) p22 (polar p2 u4 1.) ip2 (polar ip u3 1.) ) ) ((> u2 u u1) (setq ip1 (polar ip u1 1.) p21 (polar p2 u4 1.) p22 (polar p2 u3 1.) ip2 (polar ip u2 1.) ) ) (t nil) ) (setq p1 (inters ip ip1 p2 p21 nil) p3 (inters p2 p22 ip ip2 nil)) ) (t nil) ) (setvar "osmode" 0) (setvar "polarmode" opm) (setvar "polarang" opa) (setvar "autosnap" oas) (command "pline" ip p1 p2 p3 "c") (setvar "osmode" osn) (command "_.undo" "end") (princ))(prompt "\n Type > sr < : ")
Here is an idea for a lisp routine. I'm busy this morning so I have no time but trying to do some plumbing isometric drawings.I find the need to draw a rectangle in an isometric plane. So if the lisp would get the SNAPSTYL variable to establish the needed angles the user would pick the first point then while picking the second point the lines would be drawn in the correct angles.If during the process the F5 key is pressed the SNAPSTYL variable is changes and so is the iso plane.Food for thought or if someone is looking to write some code.Back to work.
(defun C:ISOREC (/ click gr p1 p2 p3 pt msg isoplane item dir oldsnstyl oldecho) (setq oldecho (getvar 'CMDECHO) oldsnstyl (getvar 'SNAPSTYL) ) (setvar 'CMDECHO 0) (setvar 'SNAPSTYL 1) (setq msg "\nSecond point or press F5 to change isoplane <exit>: " isoplane '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>") dir (list (list (/ pi -6.) (/ pi 2.)) (list (/ pi 6.) (/ pi -6.)) (list (/ pi 2.) (/ pi 6.)) ) ) (if (setq p1 (getpoint "\nStart point: ")) (progn (princ msg) (setq item (getvar 'SNAPISOPAIR)) (while (not click) (setq gr (grread T 3) pt (cadr gr) ) (cond ((= 3 (car gr)) (setq click T)) ((= 5 pt) (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) isoplane)) (princ msg) ) ((or (member (car gr) '(11 12)) (member pt '(13 32))) (setq click T pt nil) ) ((listp pt) (command "REDRAW") (grdraw p1 (setq p2 (inters p1 (polar p1 (car (nth item dir)) 1) pt (polar pt (cadr (nth item dir)) 1) nil)) 7 1) (grdraw p1 (setq p3 (inters p1 (polar p1 (cadr (nth item dir)) 1) pt (polar pt (car (nth item dir)) 1) nil)) 7 1) (grdraw pt p2 7 1) (grdraw pt p3 7 1) ) (T (princ (strcat (chr pt) msg))) ) ) (command "REDRAW") (if pt (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 10 p2) (cons 10 pt) (cons 10 p3) ) ) ) ) ) (setvar 'CMDECHO oldecho) (setvar 'SNAPSTYL oldsnstyl) (princ))
(defun c:isorec ( / *error* _isopoints _str->lst _str->pt click dir g1 g2 gr iso item msg p p1 pts snap str ucsz ) (defun *error* ( msg ) (redraw) (princ)) (defun _isopoints ( p1 p3 dir ) (list p1 (inters p1 (polar p1 (car dir) 1.) p3 (polar p3 (cadr dir) 1.) nil) p3 (inters p1 (polar p1 (cadr dir) 1.) p3 (polar p3 (car dir) 1.) nil) ) ) (defun _str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (_str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun _str->pt ( str p1 dir / pt ) (if (wcmatch str "`@*") (setq str (substr str 2)) (setq p1 '(0. 0. 0.)) ) (if (and (setq pt (mapcar 'read (_str->lst str ","))) (vl-every 'numberp pt) (= 2 (length pt)) ) (last (mapcar '(lambda ( ang disp ) (setq p1 (polar p1 ang disp))) dir pt)) ) ) (setq snap (getvar 'SNAPSTYL)) (setvar 'SNAPSTYL 1) (setq msg "\nSpecify Second Point or Press F5 to Change Isoplane <exit>: " iso '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>") dir (list (list (/ pi -6.) (/ pi 2.)) (list (/ pi 6.) (/ pi -6.)) (list (/ pi 2.) (/ pi 6.)) ) ucsz (trans '(0. 0. 1.) 1 0 t) ) (if (setq p1 (getpoint "\nSpecify First Corner Point: ")) (progn (princ msg) (setq item (getvar 'SNAPISOPAIR) str "") (while (not click) (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr)) (cond ( (= 3 g1) (setq click T) ) ( (= 2 g1) (cond ( (= 5 g2) (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) iso)) (princ msg) ) ( (= 8 g2) (and (< 0 (strlen str)) (princ (vl-list->string '(8 32 8))) (setq str (substr str 1 (1- (strlen str)))) ) ) ( (< 32 g2 127) (setq str (strcat str (princ (chr g2)))) ) ( (member g2 '(13 32)) (if (< 0 (strlen str)) (if (setq g2 (_str->pt str p1 (nth item dir))) (setq click t pts (_isopoints p1 g2 (nth item dir))) (princ (strcat (setq str "") "\n2D Point Required." msg)) ) (setq click t) ) ) ( (setq g2 nil click t) ) ) ) ( (listp g2) (redraw) (mapcar 'grdraw (setq pts (_isopoints p1 g2 (nth item dir))) (append (cdr pts) (list (car pts))) '(7 7 7 7) '(1 1 1 1) ) ) ( (setq g2 nil click t) ) ) ) (redraw) (if (and g2 pts) (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1)) (mapcar '(lambda ( p ) (cons 10 (trans p 1 ucsz))) pts) (list (cons 210 ucsz)) ) ) ) ) ) (setvar 'SNAPSTYL snap) (princ))(vl-load-com) (princ)
Good idea Lee but I think, for me anyway, the point needs to be relative. Better still would be distance offset x(on the angle),y
This is the desired result
(defun c:isorec ( / p1 p2 an n snap ) (setq snap (getvar 'SNAPSTYL)) (setvar 'SNAPSTYL 1) (if (and (setq p1 (getpoint "\nSpecify First Point: ")) (setq p2 (getpoint "\nSpecify Second Point: " p1)) (setq an (nth (getvar 'SNAPISOPAIR) (list (list (/ pi -6.) (/ pi 2.)) (list (/ pi 6.) (/ pi -6.)) (list (/ pi 2.) (/ pi 6.))) ) ) ) (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 (trans p1 1 (setq n (trans '(0. 0. 1.) 1 0 t)))) (cons 10 (trans (inters p1 (polar p1 (car an) 1.) p2 (polar p2 (cadr an) 1) nil) 1 n)) (cons 10 (trans p2 1 n)) (cons 10 (trans (inters p1 (polar p1 (cadr an) 1.) p2 (polar p2 (car an) 1) nil) 1 n)) (cons 210 n) ) ) ) (setvar 'SNAPSTYL snap) (princ))
(defun C:ISOREC (/ *error* validInput click gr p1 p2 p3 pt msg isoplane item dir oldsnstyl oldecho ip str) (defun *error* (msg) (or (= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (redraw) (princ) ) (defun validInput (str / pos len wid) (if (and (wcmatch str "`@*") (setq pos (vl-string-search "," str)) (setq len (distof (substr str 2 (1- pos)))) (setq wid (distof (substr str (+ 2 pos)))) ) (list len wid) ) ) (setq oldecho (getvar 'CMDECHO) oldsnstyl (getvar 'SNAPSTYL) ) (setvar 'CMDECHO 0) (setvar 'SNAPSTYL 1) (setq msg "\nSecond point or press F5 to change isoplane <exit>: " isoplane '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>") dir (list (list (/ pi -6.) (/ pi 2.)) (list (/ pi -6.) (/ pi 6.)) (list (/ pi 6.) (/ pi 2.)) ) ) (if (setq p1 (getpoint "\nStart point: ")) (progn (princ msg) (setq item (getvar 'SNAPISOPAIR)) (while (not click) (setq gr (grread T 3) pt (cadr gr) ) (cond ((= 3 (car gr)) (setq click T)) ((= 5 pt) (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) isoplane) ) (princ msg) ) ((member (car gr) '(11 12 25)) (setq click T pt nil ) ) ((listp pt) (redraw) (grdraw p1 (setq p2 (inters p1 (polar p1 (car (nth item dir)) 1) pt (polar pt (cadr (nth item dir)) 1) nil ) ) 7 1 ) (grdraw p1 (setq p3 (inters p1 (polar p1 (cadr (nth item dir)) 1) pt (polar pt (car (nth item dir)) 1) nil ) ) 7 1 ) (grdraw pt p2 7 1) (grdraw pt p3 7 1) ) ((member pt '(13 32)) (if (and str (setq ip (validInput str))) (progn (setq p2 (polar p1 (car (nth item dir)) (car ip)) pt (polar p2 (cadr (nth item dir)) (cadr ip)) p3 (polar p1 (cadr (nth item dir)) (cadr ip)) click T ) ) (progn (princ (strcat "\nInvalid input.\n" msg)) (setq str "") ) ) ) (T (if (= (cadr gr) 8) (or (and str (/= str "") (setq str (substr str 1 (1- (strlen str)))) (princ (chr 8)) (princ (chr 32)) ) (setq str nil) ) (or (and str (setq str (strcat str (chr (cadr gr)))) ) (setq str (chr (cadr gr))) ) ) (and str (princ (chr (cadr gr)))) ) ) ) (redraw) (if pt (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 10 p2) (cons 10 pt) (cons 10 p3) ) ) ) ) ) (setvar 'CMDECHO oldecho) (setvar 'SNAPSTYL oldsnstyl) (princ))