Lisp application for doing windows

Hi everybody.

I have one routine in Lisp to do windows in elevation and in AUTOCAD work fine, but in bricscad V.10 sometimes shows problems or doesn't work, perhaps somebody with more knowledge in Lisp could fix this routine and help me, at the same time if somebody need it, it will be a good tool for all bricscad users.  When I use the routine The snap markers turn off and the picked box for selection take the value "0". and sometimes you can do only 1 window and if you repeat again the routine, appears an error.  Please Check it and thanks.

(defun C:VENT ()
  (setq pbx (getvar "pickbox"))
  (setq osnp (getvar "osmode"))
  (command "_setvar" "PICKBOX" 0)
  (command "_setvar" "OSMODE" 0)
  (setq P1 (getpoint "\nPunto de insercion:"))
  (setq M (getdist "\nModulo de la ventna:")) 
  (setq AL (getdist "\nAltura del modulo:"))
  (setq CAN (getint "\nN§ de modulos:"))
  (setq CX (getint "\nCristales en <X>:"))
  (setq CY (getint "\nCristales en <Y>:"))
  (setq DS1 0.05)
  (setq DS2 0.03)
  (setq DS3 0.02)
  (setq DS4 (/ (-(- M (* DS1 2)) (* (+ CX 1) DS2)) CX))
  (setq DS5 (/ (-(- AL (* DS1 2)) (* (+ CY 1) DS2)) CY))
  (setq DS6 (- DS4 (* DS3 2)))
  (setq DS7 (- DS5 (* DS3 2)))
  (setq DS8 (- M (* DS1 2)))
  (setq DS9 (- AL (* DS1 2))) 
  (while (> CAN 0)
      (command "_COLOR" 5 "")
      (setq P2 (polar P1 (/ PI 2) AL))
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 0 M))
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 (* PI 1.5) AL))
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 PI M))
      (command "_LINE" P1 P2 "" )
      (setq AUX1 P1)
      (setq P1 (polar P1 (/ PI 2) DS1))
      (setq P1 (polar P1 PI (- M DS1)))
      (setq P2 (polar P2 (/ PI 2) (- AL DS1)))
      (setq P2 (polar P2 0 DS1))
      (command "_COLOR" "_bylayer" "")
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 0 DS8))
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 (* PI 1.5) DS9))
      (command "_LINE" P1 P2 "")
      (setq P1 P2)
      (setq P2 (polar P1 PI DS8))
      (command "_LINE" P1 P2 "")
      (setq CSY CY)
      (while (> CSY 0)
          (setq P1 (polar P1 (/ PI 2) DS2))
          (setq CSX CX)
          (while (> CSX 0)
              (setq P1 (polar P1 PI DS2))
              (setq P2 (polar P1 PI DS4))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 (/ PI 2) DS5))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 0 DS4))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 (* PI 1.5) DS5))
              (command "_LINE" P1 P2 "")
              (setq P1 (polar P2 PI DS4))
              (setq CSX (- CSX 1))
              (setq AUX2 P1)
              (setq P1 (polar P1 0 DS3))
              (setq P1 (polar P1 (/ PI 2) DS3))
              (setq P2 (polar P1 0 DS6))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 (/ PI 2) DS7))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 PI DS6))
              (command "_LINE" P1 P2 "")
              (setq P1 P2)
              (setq P2 (polar P1 (* PI 1.5) DS7))
              (command "_LINE" P1 P2 "")
              (setq P1 AUX2)
          )
          (setq P1 (polar P1 0 (- DS8 DS2)))
          (setq P1 (polar P1 (/ PI 2) DS5))
          (setq CSY (- CSY 1))
      )
      (setq P1 (polar P1 0 DS1))
      (setq P1 (polar P1 (* PI 1.5) DS1)) 
      (setq P1 AUX1)
      (setq CAN (- CAN 1))
  )
       (command "_setvar" "PICKBOX" PBX)
       (command "_setvar" "OSMODE" OSNP)
  (princ)
)

Comments

  • I will check this code today ... as it looks pretty fine, there should be no problem.
    Will report my results.

  • Hi Jorge,

     

    (command "_COLOR" 5 "") should by

    (command "_COLOR" 5)

     

     

    same for (command "_COLOR" "_bylayer" "") ... shoud by (command "_COLOR" "_bylayer")

     

    Try this:

     

    (defun C:VENT ()
      (setq pbx (getvar "pickbox"))
      (setq osnp (getvar "osmode"))
      (setq clr (getvar "cecolor")
            cmd (getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (command "_setvar" "PICKBOX" 0)
      (command "_setvar" "OSMODE" 0)
      (setq P1 (getpoint "\nPunto de insercion:"))
      (setq M (getdist "\nModulo de la ventna:"))
      (setq AL (getdist "\nAltura del modulo:"))
      (setq CAN (getint "\nN§ de modulos:"))
      (setq CX (getint "\nCristales en <X>:"))
      (setq CY (getint "\nCristales en <Y>:"))
      (setq DS1 0.05)
      (setq DS2 0.03)
      (setq DS3 0.02)
      (setq DS4 (/ (-(- M (* DS1 2)) (* (+ CX 1) DS2)) CX))
      (setq DS5 (/ (-(- AL (* DS1 2)) (* (+ CY 1) DS2)) CY))
      (setq DS6 (- DS4 (* DS3 2)))
      (setq DS7 (- DS5 (* DS3 2)))
      (setq DS8 (- M (* DS1 2)))
      (setq DS9 (- AL (* DS1 2)))
      (while (> CAN 0)
          (command "_COLOR" 5)
          (setq P2 (polar P1 (/ PI 2) AL))
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 0 M))
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 (* PI 1.5) AL))
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 PI M))
          (command "_LINE" P1 P2 "" )
          (setq AUX1 P1)
          (setq P1 (polar P1 (/ PI 2) DS1))
          (setq P1 (polar P1 PI (- M DS1)))
          (setq P2 (polar P2 (/ PI 2) (- AL DS1)))
          (setq P2 (polar P2 0 DS1))
          (command "_COLOR" "_bylayer")
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 0 DS8))
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 (* PI 1.5) DS9))
          (command "_LINE" P1 P2 "")
          (setq P1 P2)
          (setq P2 (polar P1 PI DS8))
          (command "_LINE" P1 P2 "")
          (setq CSY CY)
          (while (> CSY 0)
              (setq P1 (polar P1 (/ PI 2) DS2))
              (setq CSX CX)
              (while (> CSX 0)
                  (setq P1 (polar P1 PI DS2))
                  (setq P2 (polar P1 PI DS4))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 (/ PI 2) DS5))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 0 DS4))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 (* PI 1.5) DS5))
                  (command "_LINE" P1 P2 "")
                  (setq P1 (polar P2 PI DS4))
                  (setq CSX (- CSX 1))
                  (setq AUX2 P1)
                  (setq P1 (polar P1 0 DS3))
                  (setq P1 (polar P1 (/ PI 2) DS3))
                  (setq P2 (polar P1 0 DS6))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 (/ PI 2) DS7))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 PI DS6))
                  (command "_LINE" P1 P2 "")
                  (setq P1 P2)
                  (setq P2 (polar P1 (* PI 1.5) DS7))
                  (command "_LINE" P1 P2 "")
                  (setq P1 AUX2)
              )
              (setq P1 (polar P1 0 (- DS8 DS2)))
              (setq P1 (polar P1 (/ PI 2) DS5))
              (setq CSY (- CSY 1))
          )
          (setq P1 (polar P1 0 DS1))
          (setq P1 (polar P1 (* PI 1.5) DS1))
          (setq P1 AUX1)
          (setq CAN (- CAN 1))
      )
           (command "_setvar" "PICKBOX" PBX)
           (command "_setvar" "OSMODE" OSNP)
           (setvar "cecolor" clr)
           (setvar "cmdecho" cmd)
      (princ)
    )

     

  • thanks a lot Stanislav

    it works great, thank you very much.

  • Hi, Jorge,
    Stanislav was faster than me :-)
    However, just some more tips :
    instead of
    (command "color" 5)
    you can also use
    (setvar "cecolor" 5) => its faster, and prevents command reactors

    Also, instead of
    (command "_setvar" "<variable>" ...)
    you can use
    (setvar "<variable>" ...) => its also faster and prevents command reactos.

  • thanks Torsten

    I'm very glad for your answer too. You help me a lot, I will check your suggestions too. By the way, Perhaps you could reas my new question in the forum about isometric view.

    regards,

     

    jorge mora

This discussion has been closed.