very important lisp

[107199]

hi guys,

in this lisp i should select two point which is the opposite corner of a rectangular but i want to simplify it to select only the rectangular and it will specify the opposite corners automatically

(PROMPT "\n THIS PROGRAM FOR SPRINKLER DISTRIBUTION ")
(PROMPT "\n START COMMAND by :  SSP:PENDENT  SSU:UPRIGHT ")
(DEFUN C:SSP ()
(SETVAR "CMDECHO" 0)
(SETQ P1 (GETPOINT "\n ENTER FIRST POINT: "))
(SETQ P3 (GETPOINT "\n ENTER SECOND POINT: "))
(setq BB1 "M-FFSP-PE02-P")
   (setq x1 (car p1))
   (setq y1 (car (cdr p1)))
   (setq x3 (car p3))
   (setq y3 (car (cdr p3)))
   (setq p2 (list x1 y3))
   (setq p4 (list x3 y1))
   (setq disx (distance p1 p4))
   (setq disy (distance p1 p2))
   (setq disxx (abs (- x3 x1)))
   (setq disyy (abs (- y3 y1)))
(SETQ NX (+ (fix (/ disxx 4600)) 1))
(SETQ XXN (/ disx (* NX 2)))
(SETQ DS1 (* XXN 2))
(SETQ NY (+ (fix (/ disyy 4600)) 1))
(SETQ YYN (/ disy (* NY 2)))
(SETQ DS2 (* YYN 2))
   (setq xx1 (+ (car p1) XXN))
   (setq yy1 (+ (car (cdr p1)) YYN))
   (setq pp2 (list xx1 yy1))
(COMMAND "-layer" "m" "M-FIRE-SYMB-P" "c" "2" "" "")
(COMMAND "INSERT" BB1 pp2 "" "" "")
;(COMMAND "ARRAY" "L" "" "R" NY NX DS2 DS1)
    (if (eq NX 1) (COMMAND "ARRAY" "L" "" "R" NY NX DS2))
    (if (eq NY 1) (COMMAND "ARRAY" "L" "" "R" NY NX DS1))
    (if (AND (/= NX 1) (/= NY 1))(COMMAND "ARRAY" "L" "" "R" NY NX DS2 DS1))
(PRIN1)
(PRIN1)
(PROMPT "\n")
(PROMPT "\n CREATED by :")
(PROMPT "\n                  ********* M.SAIED. ********* ")
(PROMPT "\n MODIFIED by :")
(PROMPT "\n                  ********* Saber Elkassas. ********* ")
(PRINC)
);DEFUN

(DEFUN C:SSU ()
(SETVAR "CMDECHO" 0)
(SETQ P1 (GETPOINT "\n ENTER FIRST POINT: "))
(SETQ P3 (GETPOINT "\n ENTER SECOND POINT: "))
(setq BB1 "M-FFSP-UP01-P")
   (setq x1 (car p1))
   (setq y1 (car (cdr p1)))
   (setq x3 (car p3))
   (setq y3 (car (cdr p3)))
   (setq p2 (list x1 y3))
   (setq p4 (list x3 y1))
   (setq disx (distance p1 p4))
   (setq disy (distance p1 p2))
   (setq disxx (abs (- x3 x1)))
   (setq disyy (abs (- y3 y1)))
(SETQ NX (+ (fix (/ disxx 4600)) 1))
(SETQ XXN (/ disx (* NX 2)))
(SETQ DS1 (* XXN 2))
(SETQ NY (+ (fix (/ disyy 4600)) 1))
(SETQ YYN (/ disy (* NY 2)))
(SETQ DS2 (* YYN 2))
   (setq xx1 (+ (car p1) XXN))
   (setq yy1 (+ (car (cdr p1)) YYN))
   (setq pp2 (list xx1 yy1))
(COMMAND "-layer" "m" "M-FIRE-SYMB-P" "c" "2" "" "")
(COMMAND "INSERT" BB1 pp2 "" "" "")
;(COMMAND "ARRAY" "L" "" "R" NY NX DS2 DS1)
    (if (eq NX 1) (COMMAND "ARRAY" "L" "" "R" NY NX DS2))
    (if (eq NY 1) (COMMAND "ARRAY" "L" "" "R" NY NX DS1))
    (if (AND (/= NX 1) (/= NY 1))(COMMAND "ARRAY" "L" "" "R" NY NX DS2 DS1))
(PRIN1)
(PRIN1)
(PROMPT "\n")
(PROMPT "\n CREATED by :")
(PROMPT "\n                  ********* M.SAIED. ********* ")
(PROMPT "\n MODIFIED by :")
(PROMPT "\n                  ********* Saber Elkassas. ********* ")
(PRINC)
);DEFUN

[scott.rattray55FSX]

That did the trick! Thanks so much for all your help Kent!

I have one final question for you, in the original code there was 4 options for space Light (Combustible/Non-Combustible), Ordinary, and Extra. I've added on myself called Extended, it appears in the code fine and works for selection but when the blocks for Extended are inserted in uses the Extra spacing. I must be missing something in the code to add a fifth option in the search but I can't locate it this routine is definitely beyond my abilities. Would you also be able to point out the variable I need to revise?

(setvar 'cmdecho 0)
(command "_.layer" "_make" "M-FIRE-SYMB-P" "_color" "2" "" "")
(setvar 'cmdecho 1)
(vl-load-com)

(defun SS ; = Sprinkler Spacing
  (blkname / *error* ssia doc svnames svvals v1 rectss n ucschanged v3)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (if ucschanged (command-s "_.ucs" "_previous"))
      ; [change to (command ...  if Acad version predates (command-s) function]
    (mapcar 'setvar svnames svvals); reset System Variables
    (vla-endundomark doc)
    (princ)
  ); defun - *error*

  (defun ssia ; = SS Insert & Array
    (/ delta LL nLong longEdge spcMax spcLong spcShortTemp
      nShort shortEdge spcShort longX nX nY spcX spcY)
    (setq
      delta (reverse (cdr (reverse (mapcar 'abs (mapcar '- v3 v1)))))
        ; XY [only] differences list
      LL (mapcar 'min v1 v3)
        ; Lower Left regardless of pick order or Pline start or direction
      nLong 
        (+
          (fix (/ (setq longEdge (apply 'max delta)) (setq spcMax (cadr (assoc haz hazlist)))))
            ; rounded-down longer dimension divided by base max. spacing
          (if (= (rem longEdge spcMax) 0) 0 1); round up if any remainder
        ); + & nLong
      spcLong (/ longEdge nLong); spacing in long direction
      spcShortTemp (/ (caddr (assoc haz hazlist)) spcLong)
        ; max. area div. by long-direction spacing
      nShort
        (+
          (fix (/ (setq shortEdge (apply 'min delta)) spcShortTemp))
            ; rounded-down shorter dimension divided by max. spacing
          (if (= (rem shortEdge spcShortTemp) 0) 0 1); round up if any remainder
        ); + & nShort
    ); setq
    (while (> (setq spcShort (/ shortEdge nShort)) spcMax)
      ; spacing in short direction, compared to maximum spacing
      (setq nShort (1+ nShort))
    ); while
    (setq
      longX (apply '> delta); is it longer in X dimension?
      nX (if longX nLong nShort); number in X direction
      spcX (if longX spcLong spcShort); spacing in X direction
      nY (if longX nShort nLong)
      spcY (if longX spcShort spcLong)
    ); setq
    (command
      "_.insert" blkname "_none" (mapcar '+ LL (list (/ spcX 2) (/ spcY 2))) "" "" ""
      "_.array" "_last" "" "_r" nY nX
    ); command [leaves in Array command at prompt for spacing(s)]
    (cond
      ((= nX 1) (command spcY))
      ((= nY 1) (command spcX))
      (T (command spcY spcX))
    ); cond
  ); defun -- ssia

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ; System Variable saving/resetting without separate variables for each:
    svnames '(cmdecho ucsfollow osmode blipmode)
    svvals (mapcar 'getvar svnames)
  ); setq
  (mapcar 'setvar svnames '(0 0)); turn off command echoing, UCS follow
  (initget 1 "Light Ordinary Extra Extended"); 1 = no Enter
  (setq
    hazlist
      (if (= (getvar "insunits") 1)
        '( ; then
          ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
          ("Ordinary" 180 18720) ("Extra" 120 14400) ("Extended" 216 57600)
        ); end of 'then' list
        '( ; <<-- This List is now the 'Else' Expression
          ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
          ("Ordinary" 4600 12000000) ("Extra" 3048 9290000) ("Extended" 6000 37100000)
        ); <<-- end of 'else' list
      ); END of (if) setting 'hazlist' variable
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq
  (if (= haz "Light")
    (progn
      (initget 1 "Combustible Non-Combustible")
      (setq haz (getkword "\nLight Hazard subtype [Combustible/Non-combustible]: "))
    ); progn
  ); if
  (initget "Select"); allows S as input to (getpoint) function, instead of point pick
  (setq v1 (getpoint "\nFirst Corner of rectangular area for Sprinklers, or [Select]: "))
    ; [if in non-World UCS, returns in current UCS coordinates, not in WCS]
  (if (= v1 "Select"); chose that option
    (progn ; then
      (prompt "\nTo distribute Sprinklers in rectangular Polylines,")
      (if (setq rectss (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
        ; multiple selection -- only 4-vertex closed [does not check for rectangularity]
        (progn ; then
          (mapcar 'setvar svnames '(0 0 0 0 0)); also turn off Osnap, blips
          (repeat (setq n (sslength rectss)); step through selection
            (setq rect (ssname rectss (setq n (1- n))))
            (command "_.ucs" "_object" rect)
            (setq
              ucschanged T ; marker for resetting in *error*
              v1 (trans (vlax-curve-getPointAtParam rect 0) 0 1); starting vertex
              v3 (trans (vlax-curve-getPointAtParam rect 2) 0 1); third vertex [opposite corner]
            ); setq
            (ssia); run the subroutine to Insert and Array
            (command "_.ucs" "_previous")
            (setq ucschanged nil); [turn off marker]
          ); repeat
        ); progn
        (prompt "\nNo closed 4-vertex Polyline(s) selected."); else
      ); if
    ); progn
    (progn ; else [picked a point]
      (setq v3 (getcorner v1 "\nOpposite Corner: "))
      (mapcar 'setvar svnames '(0 0 0 0 0)); also turn off Osnap, blips
      (ssia); run the subroutine to Insert & Array
    ); progn
  ); if
  (mapcar 'setvar svnames svvals); reset System Variables
  (vla-endundomark doc)
  (princ)
); defun -- SS

(defun C:SSP ()
  (SS "MARKER")
); defun

(defun C:SSU ()
  (SS "SPR_PENDENT_1!2_K-5.6")
); defun

(prompt "\n THIS PROGRAM FOR SPRINKLER DISTRIBUTION ")
(prompt "\n START command by :  SSP:PENDANT  SSU:UPRIGHT ")
(prompt "\n\n CREATED by :\n                  ********* M.SAIED. ********* ")
(prompt "\n MODIFIED by :\n                  ********* Saber Elkassas & Kent Cooper. ********* ")
(princ)

[Kent1Cooper]

You have the same initial for two different keywords:

(initget 1 "Light Ordinary Extra Extended")

Change one, for example like this:

(initget 1 "Light Ordinary Extra eXtended")

and change the prompt accordingly:

  haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/eXtended]: ")

[scott.rattray55FSX]

Got it, thanks so much! Really appreciate your help!

[107199]

Hi,

Please share the final lisp code for our reference.

[paranthaman.m]

Hi ,

I am also looking for this kind of lisps. Can you share final one.

Thanks,

[Kent1Cooper]

The attached is the code in Message 41 with the correction in Message 42 -- untested.  Be sure to edit the Block names near the end.

[107199]

Hi Paran,

The lisp is still doing under modifications and updates by Kent1Cooper and many thanks for his great support, once finished we will share it to everyone.

[paranthaman.m]

@107199 

Thanks for your update.

I have checked the file which was shared earlier. In that sprinkler to sprinkler minimum distance need to be added which is 1.8m. This is for your kind information.