plz chk my new lisp window & how to imrove this. thx

[autolisp]

Dear All

plz chk lisp & how to imrove this

this program only run in mm drg

(defun wwerr (msg)
 (setq offd nil win_l nil )
 (setvar "osmode" os)
 (setvar "pickbox" pb)
 (command "layer" "s" clay "")
 (setvar "cmdecho" 1)
 (if wwolderr (setq *error* wwolderr wwolderr nil))
)
(defun ww  (/ wwlayer wwclr  os clay pb lu jmb_w lin lin_ent lin_pp splin eplin
            mplin spd epd mpd d_min _pt1 lin_l wl_lay _ang1 _pto _ang2 _ang3
            wal_thk offdt win_lt _pt2 _ang4 o_pt1 o_pt2 j_of j_p1 j_p2 j_p3
            j_p4 j_p5 j_p6 j_p7 j_p8)
()
(if *error* (setq wwolderr *error* *error* wwerr) (setq *error* wwerr))
(if (null wwlay)
      (progn
        (setq wwlay "window")
        (setq wwlayer (tblsearch "layer" wwlay))
        (if (null wwlayer)
            (progn
             (setq wwlay (getstring "\nLayer name for WINDOW : "))
             (if (tblsearch "layer" wwlay)
                 (prompt (strcat"\nWindow on " wwlay " layer.."))
                 (progn
                   (prompt (strcat"\nColor for " wwlay " layer : ")) 
                   (setq wwclr (acad_colordlg 72))
                   (command "layer" "n" wwlay "c" wwclr  wwlay  "")
                 ) 
             )    
            ) 
            (prompt "\nWINDOW ON WD LAYER")
        )
      )
  ) 
 (setq os   (getvar "osmode")
       clay (getvar "clayer")
       pb   (getvar "pickbox")
       lu   (getvar "lunits")
 )
 (if (= lu 2) (setq jmb_w 35) (setq jmb_w 1.5))
 (setvar "cmdecho" 0)
 (setvar "osmode" 512)
 (setq lin (entsel "\nSelect wall : "))
 (setq lin_ent (entget (car lin)) 
       lin_pp  (cadr lin)
 )
 (setq splin  (cdr (assoc 10 lin_ent))
       eplin  (cdr (assoc 11 lin_ent))
       mplin  (osnap lin_pp "midp")
       lin_pp (osnap lin_pp "nea")
 )
 (setq spd (distance splin lin_pp)
       epd (distance eplin lin_pp)
       mpd (distance mplin lin_pp)
 )
 (setq d_min (min spd epd mpd))
 (if (= d_min spd) (setq _pt1 splin))
 (if (= d_min epd) (setq _pt1 eplin))
 (if (= d_min mpd) (setq _pt1 mplin))
 (setq lin_l (distance eplin splin)
       wl_lay (cdr (assoc 8 lin_ent))
       _ang1 (angle _pt1 mplin)
 )
 ;;;;;;;;;;;;;; offd= offset from endpoint;;;;;;;;;;;;;;;;
 (setvar "osmode" 128)
 (setq _pto  (getpoint lin_pp "\nSelect opposite wall : "))
 (setq _ang2 (angle lin_pp _pto)
       _ang3 (angle _pto lin_pp)
       wal_thk (distance lin_pp _pto)
 )
 (if (or (= d_min spd) (= d_min epd))
     (progn 
       (if (null offd) 
           (setq offd "600") 
           (setq offd (rtos offd lu 2))
       )
       (setq offdt (getdist _pt1 (strcat "\nOffset distance < " offd " > : ")))
       (if (not offdt) (setq offd (atof offd)) (setq offd offdt))
       (if (or (not offd) (=  offd  0) (zerop offd) )
           (setq _pt1 _pt1)
           (setq _pt1 (polar _pt1 _ang1 offd))
       )
     )
 )
 ;;;;;;;;;;;;;;win_l = window length;;;;;;;;;;;;;;;;;;;;;;;
 (if (null win_l) 
     (setq win_l (rtos (- lin_l 600) lu 2))
     (setq win_l (rtos win_l lu 2))
 )
 (setq win_lt (getdist _pt1 (strcat "\nWindow length < " WIN_L  " > : ")))
 (if (not  win_lt) 
     (setq win_l (atof win_l))
     (setq win_l win_lt) 
 )
 ;;;;;;;;;;;;;points;;;;;;;;;;;;;;;;;;
 (if (= d_min mpd) 
     (setq _pt1 (polar mplin (angle eplin splin) (/ win_l 2)) 
           _pt2 (polar mplin (angle splin eplin) (/ win_l 2))  
     )      
     (setq _pt2 (polar _pt1  _ang1 win_l))
 )
 (setq _ang1 (angle _pt1 _pt2)
       _ang4 (angle _pt2 _pt1)
 )
 (setq _ang5 (angle _pt2 _pt1)
       _ang6 (angle _pt1 _pt2)
 )
 (setq o_pt1 (polar _pt1 _ang2 wal_thk)
       o_pt2 (polar _pt2 _ang2 wal_thk)
       j_of  (/ wal_thk 2.75)
       j_p1  (polar _pt1 _ang2 j_of)
       j_p2  (polar j_p1 _ang1 jmb_w)
       j_p4  (polar o_pt1 _ang3 j_of)
       j_p3  (polar J_p4 _ang1 jmb_w)
       j_p5  (polar _pt2 _ang2 j_of)
       j_p6  (polar j_p5 _ang4 jmb_w)
       j_p8  (polar o_pt2 _ang3 j_of)
       j_p7  (polar J_p8 _ang4 jmb_w)
 )
 (setvar "osmode" 0)
 (setvar "pickbox" 1)
 (command  "break" lin_pp "f" _pt1 _pt2
           "break" _pto "f" o_pt1 o_pt2)

 (joint _pt2 o_pt2 wal_thk _ang6 wl_lay)
 (joint _pt1 o_pt1 wal_thk _ang5 wl_lay)
 (command  "layer" "t" wwlay  "on" wwlay "s" wwlay ""
           "pline" j_p1 j_p2 j_p3 j_p4 "c"
           "pline" j_p5 j_p6 j_p7 j_p8 "c"
           "line"  j_p2 j_p6 ""
           "line"  j_p3 j_p7 ""
           "line" _pt1 _pt2 ""
           "line" o_pt1 o_pt2 ""
 )
 (setvar "pickbox" pb)
 (setvar "osmode" os)
 (command "layer" "s" clay "")
 (if wwolderr (setq *error* wwolderr wwolderr nil) (setq *error* nil))
 (sk)
 (setvar "cmdecho" 1)
) 

(defun joint (jt1 jt2 wlt angw walay / ang1 ang2 pt10 pt11 pt12 pt13 ch10
             ch11 ch12 ch13 ch11_ent ch12_ent ch11_ep ch11_sp ch12_sp ch12_ep
             sub12e sub12s sub11e sub11s 14_ep 14_sp)
(setq ang1 (+ angw (dtr 90)))
(setq ang2 (- angw (dtr 90)))
(setq pt10  (polar jt1 angw (/ wlt 2))
      pt11  (polar jt1 ang1 (* wlt 1.2))
      pt12  (polar jt1 ang2 (* wlt 1.2))
      pt13  (polar jt2 angw (/ wlt 2))
)
(command "layer" "s" walay "")
(setq ch10  (ssget pt10 (list (cons 8 walay))))
(setq ch13  (ssget pt13 (list (cons 8 walay))))
(setq ch11  (ssget pt11 (list (cons 8 walay))))
(setq ch12  (ssget pt12 (list (cons 8 walay))))
(if (and ch10 ch13)
    (command "line" jt1 jt2 "")
    (progn
      (if (and ch10 ch11) (command "fillet" pt10 pt11 ) )
      (if (and ch10 ch12) (command "fillet" pt10 pt12 ) )
      (if (and ch13 ch11) (command "fillet" pt13 pt11 ) )
      (if (and ch13 ch12) (command "fillet" pt13 pt12 ) )
      (if (and ch11 ch12)
        (progn 
          (setq ch11_ent (entget (ssname ch11 0)))
          (setq ch12_ent (entget (ssname ch12 0)))
          (setq ch11_ep  (cdr (setq sub11e (assoc 10 ch11_ent))))
          (setq ch11_sp  (cdr (setq sub11s (assoc 11 ch11_ent))))
          (setq ch12_ep  (cdr (setq sub12e (assoc 10 ch12_ent))))
          (setq ch12_sp  (cdr (setq sub12s (assoc 11 ch12_ent))))
          (if (< (distance pt11 ch11_sp) (distance pt11 ch11_ep))
              (setq 14_ep ch11_ep)
              (setq 14_ep ch11_sp)
          )
          (if (< (distance pt12 ch12_sp) (distance pt12 ch12_ep))
              (setq 14_sp ch12_ep)
              (setq 14_sp ch12_sp)
          )
          (command "erase" pt12 "")
          (entmod (subst (cons 10 14_ep) sub11e ch11_ent))
          (entmod (subst (cons 11 14_sp) sub11s ch11_ent))
        )
      )
    )
)
)

(defun c:wwnl () (setq wwlay nil) (ww))
(defun c:ww () (WW) )

[BIGAL]

What does it do ?

[Tharwat]

The following part must be as the following .

First you get your own settings,

(setq os   (getvar "osmode")
       clay (getvar "clayer")
       pb   (getvar "pickbox")
       lu   (getvar "lunits")
 )

 

Then reset them back according to what they were before.

 

(defun wwerr (msg)
 (setq offd nil win_l nil )
 (setvar "osmode" os)
 (setvar "pickbox" pb)
 (command "layer" "s" clay "")
 (setvar "cmdecho" 1)
 (if wwolderr (setq *error* wwolderr wwolderr nil))
)

 

This what I noticed quickly.

 

Regards

 

Tharwat

[autolisp]

The following part must be as the following .

First you get your own settings,

(setq os   (getvar "osmode")
       clay (getvar "clayer")
       pb   (getvar "pickbox")
       lu   (getvar "lunits")
 )

 

Then reset them back according to what they were before.

 

(defun wwerr (msg)
 (setq offd nil win_l nil )
 (setvar "osmode" os)
 (setvar "pickbox" pb)
 (command "layer" "s" clay "")
 (setvar "cmdecho" 1)
 (if wwolderr (setq *error* wwolderr wwolderr nil))
)

 

This what I noticed quickly.

 

Regards

 

Tharwat

dear sir

thx for help

[Tharwat]

You're welcome.

 

What's the purpose for your Lisp, I mean the outcome ?

[autolisp]

dear all

 

plz help me below code

if there no layer in drg how can create automatic

 

 

(if (null wwlay)
      (progn
        (setq wwlay "window")
        (setq wwlayer (tblsearch "layer" wwlay))
        (if (null wwlayer)
            (progn
             (setq wwlay (getstring "\nLayer name for WINDOW : "))
             (if (tblsearch "layer" wwlay)
                 (prompt (strcat"\nWindow on " wwlay " layer.."))
                 (progn
                   (prompt (strcat"\nColor for " wwlay " layer : ")) 
                   (setq wwclr (acad_colordlg 72))
                   (command "layer" "n" wwlay "c" wwclr  wwlay  "")
                 ) 
             )    
            ) 
            (prompt "\nWINDOW ON WD LAYER")
        )
      )
  )