very important lisp

107199 · ‎12-09-2016

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

john.uhden · ‎12-15-2016

(initget "Light Ordinary Extra")
(setq haz (getpoint "\nSpeciefy Space Hazard Type [Light/<Ordinary>/Extra]: "))
(cond
  ((= haz "Light") ;; with a CAPITAL L
       (setq
	dis 4600
        area 21000000
       )
   )
   ((or (not haz)(= haz "Ordinary"))
       (setq
        dis 4600
        area 12000000
       )
   )
   ((= haz "Extra")
       (setq
        dis 3700
        area 9000000
       )
   )
   (T (princ "haz is a coordinate point"))
)

John F. Uhden

107199 · ‎12-16-2016

Thanks for your help but now i'm trying to make lisp specify that the longest Dim. is the X direction whatever is was to start divide by it

john.uhden · ‎12-19-2016

I am not understanding you very well. but if you mean that dis is the length in the X direction, and the area is of a rectangle, then:

(setq disY (/ area dis))

If the area is of a circle, well then you figure it out. (Hint: I could say it has something to do with the radius and pi, but it's a lot easier than that; same for a square too, if you catch my drift.)

John F. Uhden

Kent1Cooper · ‎12-21-2016

@107199 wrote:

....now i'm trying to make lisp specify that the longest Dim. is the X direction whatever is was to start divide by it

Here's one way to do that [lightly tested]:

(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 spcLong spcShortTemp nShort 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 (1+ (fix (/ (apply 'max delta) (cadr (assoc haz hazlist)))))
        ; round up longer dimension divided by base max. spacing
      spcLong (/ (apply 'max delta) nLong); spacing in long direction
      spcShortTemp (/ (caddr (assoc haz hazlist)) spcLong)
        ; max. area div. by long-direction spacing
      nShort (1+ (fix (/ (apply 'min delta) spcShortTemp)))
        ; round up shorter dimension divided by max. spacing
      spcShort (/ (apply 'min delta) nShort); spacing in short direction
      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"); 1 = no Enter
  (setq
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra]: ")
    hazlist '(("Light" 4600 21000000) ("Ordinary" 4600 12000000) ("Extra" 3700 9000000))
  ); setq
  (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)); 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)); 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 "M-FFSP-PE02-P")
); defun

(defun C:SSU ()
  (SS "M-FFSP-UP01-P")
); 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)

And a question occurs to me: How likely is it that the dimensions of the areas might ever come out exactly at a multiple of the maximum spacing? If it does, this code will give you one more row [or column] of sprinklers than you really need. If that's at all likely, it can be adjusted easily enough to not add one in the nLong or nShort variables if the distance divides exactly.

Kent Cooper, AIA

107199 · ‎12-24-2016

Thanks for your co-operation but still there is some problem:

1- if is quotient of X Dim ( The longest side ) by the maximum distance (4600,3700 etc) is 0 use only fix if not use fix+1

2- if the calculated Y Distance is Bigger than the maximum distance (4600,3700 etc) use NY+1

3-there is another condtion after light hazard which is( Combustible Non-Combustible)

for Combustible ( Area = 21000000 , Spacing= 4600) -- for Non-Combustible ( Area = 18000000 , Spacing= 4600)

Kent1Cooper · ‎12-24-2016

@107199 wrote:

....

3-there is another condtion after light hazard which is( Combustible Non-Combustible)

for Combustible ( Area = 21000000 , Spacing= 4600) -- for Non-Combustible ( Area = 18000000 , Spacing= 4600)

Your 1 and 2 can be worked out, but I have some questions about 3:

Should it ask for the combustible / non-combustible choice only after the User specifies the Light-hazard condition, or should there be 4 choices in the first list of conditions?

Are you sure those numbers are correct? It looks like the non-combustible light-hazard condition would require more sprinklers than the combustible condition [smaller maximum area], which doesn't make sense to me.

Kent Cooper, AIA

107199 · ‎12-25-2016

1- after light hazard only.
2- yes it's ,reverse numbers please.

107199 · ‎01-01-2017

????

Kent1Cooper · ‎01-01-2017

[Have patience.... We're all just pitching in when we have time and inclination, and it's been a very busy time of year(s).]

I think the attached does all you've asked for [very lightly tested].

Kent Cooper, AIA

Kent1Cooper · ‎01-02-2017

@107199 wrote:

....
2- yes it's ,reverse numbers please.

Thinking about it some more, I'm not sure what you meant by that. The routine I attached was written assuming that you meant "Yes, it's correct that the numbers are what seems the reverse of what you expected [i.e. Non-combustible does require more sprinkler heads than Combustible]." But now I'm wondering whether you meant "Yes, you are correct that Non-combustible should need fewer sprinkler heads than Combustible, so please reverse those numbers." If I assumed incorrectly and you really meant the latter, you can do the reversing -- just change this line:

("Combustible" 4600 21000000) ("Non-Combustible" 4600 18000000); Light subtypes

to this:

("Combustible" 4600 18000000) ("Non-Combustible" 4600 21000000); Light subtypes

Kent Cooper, AIA

107199 · ‎12-10-2017

hello all,

I have an issue as the lisp attached lisp isn't work with attached polylines in the file

(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"); 1 = no Enter
  (setq
    hazlist
      '(
        ("Combustible" 4600 18600000) ("Non-Combustible" 4600 20900000); Light subtypes
        ("Ordinary" 4600 12100000) ("Extra" 3700 8400000)
      )
    haz "Light"
  ); setq
  (if (= haz "Light")
    (progn
      (setq haz "Non-Combustible")
    ); progn
  ); if
  (setq v1 "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)); 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)); 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 "M-FFSP-PE02-P")
); defun

(defun C:SSU ()
  (SS "M-FFSP-UP01-P")
); 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 · ‎12-10-2017

@107199 wrote:

....

I have an issue as the lisp attached lisp isn't work with attached polylines in the file

For me, it works if you don't include any that are small enough to require only one head. It's the one-element Array that gets a "nothing to do" message the first time it gets to one of those, that causes the problem.

Replace this part:

....
    (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
....

with this:

....
    (command "_.insert" blkname "_none" (mapcar '+ LL (list (/ spcX 2) (/ spcY 2))) "" "" "")
    (if (or (> nX 1) (> nY 1)); more than one head needed?
      (prong ; then
        (command "_.array" "_last" "" "_r" nY nX); [leaves in Array command at prompt for spacing(s)]
        (cond
          ((= nX 1) (command spcY))
          ((= nY 1) (command spcX))
          (T (command spcY spcX))
        ); cond
      ); progn
    ); if
....

Kent Cooper, AIA

107199 · ‎12-20-2017

Thanks for your kind help but the problem still exist as when selecting all rectangular only one or two are being furnished.the attached is the file to show the exact issue.

(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))) "" "" "")
    (if (or (> nX 1) (> nY 1)); more than one head needed?
      (prong ; then
        (command "_.array" "_last" "" "_r" nY nX); [leaves in Array command at prompt for spacing(s)]
        (cond
          ((= nX 1) (command spcY))
          ((= nY 1) (command spcX))
          (T (command spcY spcX))
        ); cond
      ); progn
    ); if
  ); 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"); 1 = no Enter
  (setq
    hazlist
      '(
        ("Combustible" 4600 18600000) ("Non-Combustible" 4600 20900000); Light subtypes
        ("Ordinary" 4600 12100000) ("Extra" 3700 8400000)
      )
    haz "Light"
  ); setq
  (if (= haz "Light")
    (progn
      (setq haz "Non-Combustible")
    ); progn
  ); if
  (setq v1 "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)); 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)); 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 "M-FFSP-PE02-P")
); defun

(defun C:SSU ()
  (SS "M-FFSP-UP01-P")
); 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 · ‎12-20-2017

Auto-correct strikes again! This has happened before, but I don't always notice. Change the one instance of prong to progn.

Kent Cooper, AIA

scott.rattray55FSX · ‎12-22-2021

Hi @Kent1Cooper , first off, I wanted to thank you for your work in helping develop this lisp. I was wondering if you could assist me in also having the spacing distances work for both Metric and Imperial projects. I've attempted to add it in below for Inches and mm but am not having any success.

(setvar 'cmdecho 0)
(command "_.layer" "_make" "SPRINK-LAYOUT" "_color" "71" "" "")
(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"); 1 = no Enter
  (setq
    hazlist
      '(
        (if (= (getvar "insunits") 1)
                      (progn
        ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
        ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended Coverage" 240 57600)
                      );end progn
        (if (= (getvar "insunits") 4)
                      (progn
        ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
        ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended Coverage" 6000 37100000)
                      );end progn
      );end progn
    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)); 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)); 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 "SPR_PENDENT_1!2_K-5.6")
); defun

(defun C:SSU ()
  (SS "SPR_UPRIGHT_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 · ‎12-22-2021

Give us more information about what you mean by "not having any success." What happens differently from what you intend? Are there any error messages? Etc.

But one thing I notice:

You can't use the "quoted list" approach [the apostrophe before the opening left parenthesis of a list] if there's anything in the list that needs to be evaluated [calculation or comparison functions, reading variable or system variable names, etc.]. And some of your (progn) functions, I think, should be (list) functions instead, though it looks like those can be "quoted lists." So I think this much:

  (setq
    hazlist
      '(
        (if (= (getvar "insunits") 1)
                      (progn
        ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
        ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended Coverage" 240 57600)
                      );end progn
        (if (= (getvar "insunits") 4)
                      (progn
        ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
        ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended Coverage" 6000 37100000)
                      );end progn
      );end progn
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq

at least needs to be something more like [untested]:

  (setq
    hazlist
      (list
        (if (= (getvar "insunits") 1)
                      '(
        ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
        ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended Coverage" 240 57600)
                      );end list
        (if (= (getvar "insunits") 4)
                      '(
        ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
        ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended Coverage" 6000 37100000)
                      );end list
      );end list
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq

Kent Cooper, AIA

scott.rattray55FSX · ‎12-22-2021

Hi @Kent1Cooper , Thanks for your quick response, I used your approach but I still receive an error "malformed list on input" when I go to load the application. Scratching my head on this one.

(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
      (list
        (if (= (getvar "insunits") 1)
                      '(
        ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
        ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended" 240 57600)
                      );end list
        (if (= (getvar "insunits") 4)
                      '(
        ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
        ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended" 6000 37100000)
                      );end list
      );end list
    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)); 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)); 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 · ‎12-22-2021

Is INSUNITS ever any value other than 1 or 4? Looking more closely, I see the (if) function that decides what to put into the 'hazlist' variable is built incorrectly, and could be simpler if it's only going to be 1 or 4. Here's the plain correction, though longer than necessary:

  (setq
    hazlist
      (list
        (if (= (getvar "insunits") 1)
          '( ; then
            ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
            ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended" 240 57600)
          );end 'then' list
          (if (= (getvar "insunits") 4) ; else expression of first (if)
            '( ; then
              ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
              ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended" 6000 37100000)
            );end second (if)'s 'then' list
          ); end second if <<--- ADDED
        ); end first if <<--- ADDED
      );end list & 'hazlist' variable
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq

But if it can be only 1 or 4, and it's not 1, then it's not necessary to test whether it's 4, because it must be. You can just use the other list as the 'else' expression to one (if) function:

  (setq
    hazlist
      (list
        (if (= (getvar "insunits") 1)
          '( ; then
            ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
            ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended" 240 57600)
          ); end of 'then' list
;;;;          (if (= (getvar "insunits") 4) ; <<-- REMOVED
          '( ; <<-- THIS LIST IS NOW THE 'ELSE' EXPRESSION
            ("Combustible" 4600 12000000) ("Non-Combustible" 4600 2090000); Light subtypes
            ("Ordinary" 4600 12000000) ("Extra" 3650 9290000) ("Extended" 6000 37100000)
          ); <<-- end of 'else' list
;;;;          ); end second if <<--- REMOVED
        ); <<-- THIS IS NOW THE END OF THE ONE (if) FUNCTION
      );end list & 'hazlist' variable
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq

Kent Cooper, AIA

scott.rattray55FSX · ‎01-04-2022

Hi Kent, happy new year! Following up on your suggestions, I get "Error: bad argument type: numberp: nil" for both options you provided. You are correct though it will only ever be 1 or 4, so the second would work with less code requirement.

Thanks again for your help!

Kent1Cooper · ‎01-04-2022

@scott.rattray55FSX wrote:

.... I get "Error: bad argument type: numberp: nil" for both options you provided. ....

Looking at it more deeply, if you're pulling numbers from sublists in the 'hazlist' variable with this kind of thing:

(cadr (assoc haz hazlist))

then I think 'hazlist' is being made too many layers deep -- a list containing a list containing the sublists for each category, where it should be only a list containing those sublists. Does it work if you do this for that same stretch of code?

  (setq
    hazlist
;;;;;      (list  ;;;;; <-- REMOVE THIS
      (if (= (getvar "insunits") 1)
        '( ; then
          ("Combustible" 180 18720) ("Non-Combustible" 180 32400); Light subtypes
          ("Ordinary" 180 18720) ("Extra" 144 14400) ("Extended" 240 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" 3650 9290000) ("Extended" 6000 37100000)
        ); <<-- end of 'else' list
      ); END of (if) setting 'hazlist' variable
;;;;;      );end list & 'hazlist' variable  ;;;;; <-- REMOVE THIS
    haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra/Extended]: ")
  ); setq

Kent Cooper, AIA

Community

very important lisp

very important lisp

very important lisp