Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/09/2020 in all areas

  1. Based on @asos2000 comment, try this minimally tested : (defun c:room-unfold ( / osm p1 p2 wall ans done openings doors windows walls doorh windp windh roomh p room ll ur v dx d ) (setq osm (getvar 'osmode)) (setvar 'osmode 33) (while (not done) (setq p1 (getpoint "\nPick or specify first wall corner <ENTER - NO WALLS> : ")) (if (null p1) (setq done t) (progn (initget 1) (setq p2 (getpoint p1 "\nPick or specify second wall corner : ")) (setq wall (cons (list p1 p2) wall)) (while (not openings) (initget "Yes No") (setq ans (getkword "\nWall has openings [Yes/No] <Yes> : ")) (if (null ans) (setq ans "Yes") ) (if (= ans "Yes") (progn (while (not doors) (setq p1 (getpoint "\nPick or specify first door anchor point <ENTER - NO DOORS> : ")) (if (null p1) (setq doors t) (progn (initget 1) (setq p2 (getpoint p1 "\nPick or specify second door anchor point : ")) (setq wall (append wall (list (list "D" p1 p2)))) ) ) ) (while (not windows) (setq p1 (getpoint "\nPick or specify first window anchor point <ENTER - NO WINDOWS> : ")) (if (null p1) (setq windows t) (progn (initget 1) (setq p2 (getpoint p1 "\nPick or specify second window anchor point : ")) (setq wall (append wall (list (list "W" p1 p2)))) ) ) ) (setq openings t doors nil windows nil) ) (setq openings t) ) ) (setq walls (cons wall walls) openings nil wall nil) ) ) ) (initget 7) (setq doorh (getdist "\nPick or specify doors height : ")) (initget 7) (setq windp (getdist "\nPick or specify windows parapet : ")) (initget 7) (setq windh (getdist "\nPick or specify windows height : ")) (setq roomh 0.0) (while (<= roomh (apply 'max (list doorh (+ windp windh)))) (initget 7) (setq roomh (getdist "\nPick or specify room height : ")) ) (initget 1) (setq p (getpoint "\nPick or specify insertion point : ")) (setq room (mapcar 'car walls)) (setq ll (list (apply 'min (mapcar 'car (apply 'append room))) (apply 'min (mapcar 'cadr (apply 'append room))))) (setq ur (list (apply 'max (mapcar 'car (apply 'append room))) (apply 'max (mapcar 'cadr (apply 'append room))))) (setq v (mapcar '- p ll)) (vl-cmdf "_.PLINE") (foreach pp (mapcar 'car room) (vl-cmdf "_non" (mapcar '+ pp v)) ) (vl-cmdf "_C") (setq dx (/ (- (car ur) (car ll)) 10.0)) (setq p (mapcar '+ v (list (+ (car ur) dx) (cadr ll)))) (foreach wall (reverse walls) (setq d (apply 'distance (car wall))) (vl-cmdf "_.RECTANGLE" "_non" p "_non" (mapcar '+ p (list d roomh))) (foreach opening (cdr wall) (if (= (car opening) "D") (vl-cmdf "_.RECTANGLE" "_non" (mapcar '+ p (list (distance (caar wall) (cadr opening)) 0.0)) "_non" (mapcar '+ p (list (distance (caar wall) (caddr opening)) doorh))) (vl-cmdf "_.RECTANGLE" "_non" (mapcar '+ p (list (distance (caar wall) (cadr opening)) windp)) "_non" (mapcar '+ p (list (distance (caar wall) (caddr opening)) (+ windp windh)))) ) ) (setq p (mapcar '+ p (list (+ d dx) 0.0))) ) (setq v (mapcar '- p ll)) (vl-cmdf "_.PLINE") (foreach pp (mapcar 'car room) (vl-cmdf "_non" (mapcar '+ pp v)) ) (vl-cmdf "_C") (setvar 'osmode osm) (princ) ) HTH., M.R.
    1 point
  2. Here is a pretty simple way, there is probably a smarter way. (defun c:test ( / doc plotabs x tabname) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq oldctab (getvar 'ctab)) (vlax-for lay (vla-get-Layouts doc) (setq plotabs (cons (vla-get-name lay) plotabs)) ) (repeat (setq x (length plotabs)) (setq tabname (nth (setq x (- x 1)) plotabs)) (if (/= tabname "Model") (progn (setvar 'ctab tabname) (command "psltscale" 0) ) ) ) (setvar 'ctab oldctab) (princ) )
    1 point
×
×
  • Create New...