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

stevor · ‎12-09-2016

Let us guess, do you want to select an object,

of a LWPOLYLINE that forms a rectangle,

and find the nearest and opposite corners?

S

patrick_35 · ‎12-09-2016

Hi

Use Getcorner

@+

Les Lisps de Patrick_35

Kent1Cooper · ‎12-09-2016

Try something like this, to have the User either pick a point or type S to get the Select option:

.... your other code ....

(SETVAR "CMDECHO" 0)

(initget "Select"); allows S as input to (getpoint) function, instead of point pick
(SETQ P1 (GETPOINT "\n ENTER FIRST POINT or [Select]: "))

(if (= P1 "Select"); chose that option

(setq ; then

rect (car (entsel "\nSelect rectangle: "))

P1 (vlax-curve-getPointAtParam rect 0); starting vertex

P3 (vlax-curve-getPointAtParam rect 2); third vertex [opposite corner]

); setq

(SETQ P3 (GETPOINT "\n ENTER SECOND POINT: ")); else [picked a point]

); if
(setq BB1 "M-FFSP-PE02-P")

.... your other code ....

You may need to add this line to your code, preferably before or after the outside parentheses of the (defun) function:

(vl-load-com)

It could be made to restrict the selection to a Polyline, and check that it's closed with 4 vertices, and even whether it's actually rectangular, and made up of only line segments, and so on. And it could be made to use specifically certain corners, such as the lower left and upper right, regardless of where the starting vertex is.

Kent Cooper, AIA

Ranjit_Singh · ‎12-09-2016

You can try this. It asks for the entity. Select roughly close to one of the desired diagonally opposite points and it should calc p1 and p3

(setq a         (entsel)
      distances (vl-sort (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (cons (distance (cadr a) (cdr x)) (append (cdr x) (cddr p1))))) (entget (car a)))) '(lambda (x y) (> (car x) (car y))))
      p1        (cdar distances)
      p3        (cdr (cadddr distances)))

107199 · ‎12-09-2016

it worked perfect on the aligned rectangular with plan but when the rectangular become unaligned the result blocks deal with this as it was aligned so how to solve this issue ?? and how to select many rectangular s to apply this lisp for them at the same time

Kent1Cooper · ‎12-09-2016

@107199 wrote:

it worked perfect on the aligned rectangular with plan but when the rectangular become unaligned the result blocks deal with this as it was aligned so how to solve this issue ?? and how to select many rectangular s to apply this lisp for them at the same time

I assume you are describing the difference between orthogonal and non-orthogonal rectangles. I think the way to do non-orthogonal ones would be to align the User Coordinate System with them, and there will be a need for some (trans) functions to convert their WCS vertex locations to their own UCS. Do you know enough to be able to figure that out?

If you Search this Forum for code that contains (ssget AND (repeat AND (sslength, you should find examples of how to select multiple objects and work with each one. Is that something you can figure out?

Kent Cooper, AIA

107199 · ‎12-09-2016

yes, i am talking about ortho and non-ortho one but what i would to is selecting ortho and non-ortho rectangular and apply lisp for them both at the same step but i am still beginner to figure it so i need more help and about selecting them all can you provide me the associated code or topic please?

Kent1Cooper · ‎12-10-2016

@107199 wrote:

.... how to select many rectangular s to apply this lisp for them at the same time

Not dealing with the non-orthogonal issue yet, and I don't know why you started a separate thread about multiple rectangles, but here's a way to have the option to select more than one. Lightly tested.

But I made significant other changes, too. Since the two command names are identical except for the Block name, I set it up to have one routine that does all the work, and two command names that just call for that same routine but supply the different Block names. And there's one subroutine to do the Inserting and Arraying, which is called up when needed by the two commands, depending on whether points were picked or Polylines [one or many] selected. Also, it does the Layer thing upon loading, not within each command, so that when you use it more than once in the same editing session of the same drawing, it doesn't have to do that every time.

Your original code looks like it would work correctly only if the first point picked was the lower left corner. This finds the lower left corner of the rectangular area, whether it was two picked points at any pair of opposite corners and in either order, or a Polyline, whichever corner it starts at and whichever direction it was drawn.

It also uses far fewer variables, getting at certain things about the size of a rectangle [or rectangular area] in shorter ways. It doesn't have error handling, nor does it check whether selected Polylines are closed or actually rectangular [it checks only whether they have four vertices], nor does it allow "heavy" Polylines if you might ever need that. But all of those things can be added if it does what you want otherwise.

Spoiler

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

(defun SS (blkname / P1 rectss n P3)
(setvar 'cmdecho 0)
(initget "Select"); allows S as input to (getpoint) function, instead of point pick
(setq P1 (getpoint "\n ENTER FIRST POINT or [Select]: "))
(if (= P1 "Select"); chose that option
    (progn ; then
      (if (setq rectss (ssget '((0 . "LWPOLYLINE") (90 . 4)))); multiple selection
        (repeat (setq n (sslength rectss)); step through selection
          (setq
            rect (ssname rectss (setq n (1- n)))
            P1 (vlax-curve-getPointAtParam rect 0); starting vertex
            P3 (vlax-curve-getPointAtParam rect 2); third vertex [opposite corner]
          ); setq
          (ssia); run the subroutine to Insert and Array
        ); repeat
        (prompt "\nNo rectangular Polyline(s) selected.")
      ); if
    ); progn
    (progn ; else [picked a point]
      (setq P3 (getcorner P1 "\n ENTER SECOND POINT: "))
      (ssia); run the subroutine to Insert and Array
    ); progn
); if
(setvar 'cmdecho 1)
(princ)
); defun -- SS

(defun ssia (/ delta LL NX NY DS1 DS2); = SS Insert & Array
(setq
    delta (mapcar 'abs (mapcar '- P3 P1)); differences in XYZ list
    LL (mapcar 'min P1 P3)
      ; Lower Left regardless of pick order or Pline start or direction
    NX (+ (fix (/ (car delta) 4600)) 1)
    NY (+ (fix (/ (cadr delta) 4600)) 1)
    DS1 (/ (car delta) NX)
    DS2 (/ (cadr delta) NY)
); setq
(command
    "_.insert" blkname "_none" (mapcar '+ LL (list (/ DS1 2) (/ DS2 2))) "" "" ""
    "_.array" "_last" "" "_r" NY NX
); command [leaves it in Array awaiting spacing(s)
(cond
    ((= NX 1) (command DS2))
    ((= NY 1) (command DS1))
    (T (command DS2 DS1))
); cond
); defun -- ssia

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

(setvar 'cmdecho 0)(command "_.layer" "_make" "M-FIRE-SYMB-P" "_color" "2" "" "")(setvar 'cmdecho 1) (defun SS (blkname / P1 rectss n P3) (setvar 'cmdecho 0) (initget "Select"); allows S as input to (getpoint) function, instead of point pick (setq P1 (getpoint "\n ENTER FIRST POINT or [Select]: ")) (if (= P1 "Select"); chose that option (progn ; then (if (setq rectss (ssget '((0 . "LWPOLYLINE") (90 . 4)))); multiple selection (repeat (setq n (sslength rectss)); step through selection (setq rect (ssname rectss (setq n (1- n))) P1 (vlax-curve-getPointAtParam rect 0); starting vertex P3 (vlax-curve-getPointAtParam rect 2); third vertex [opposite corner] ); setq (ssia); run the subroutine to Insert and Array ); repeat (prompt "\nNo rectangular Polyline(s) selected.") ); if ); progn (progn ; else [picked a point] (setq P3 (getcorner P1 "\n ENTER SECOND POINT: ")) (ssia); run the subroutine to Insert and Array ); progn ); if (setvar 'cmdecho 1) (princ)); defun -- SS (defun ssia (/ delta LL NX NY DS1 DS2); = SS Insert & Array (setq delta (mapcar 'abs (mapcar '- P3 P1)); differences in XYZ list LL (mapcar 'min P1 P3) ; Lower Left regardless of pick order or Pline start or direction NX (+ (fix (/ (car delta) 4600)) 1) NY (+ (fix (/ (cadr delta) 4600)) 1) DS1 (/ (car delta) NX) DS2 (/ (cadr delta) NY) ); setq (command "_.insert" blkname "_none" (mapcar '+ LL (list (/ DS1 2) (/ DS2 2))) "" "" "" "_.array" "_last" "" "_r" NY NX ); command [leaves it in Array awaiting spacing(s) (cond ((= NX 1) (command DS2)) ((= NY 1) (command DS1)) (T (command DS2 DS1)) ); cond); defun -- ssia (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)

Kent Cooper, AIA

107199 · ‎12-11-2016

Good Job Kent Cooper but till now it can't deal with the non ortho ones which is the most common case in my project so is there a way to deal with this?

salman_majgaonkar · ‎12-12-2016

try this code

(DEFUN C:SSP ()
(SETVAR "CMDECHO" 0)

(setq AAA1 (ssget '((0 . "LWPOLYLINE"))))
(setq AAA2 0)
(repeat (sslength AAA1)
(setq AAA3 (ssname AAA1 AAA2))
(setq AAA4 (entget AAA3))
(setq AAA5 0)
(setq AAA6 (list))
(repeat (length AAA4)
(setq AAA7 (nth AAA5 AAA4))
(if (= (car AAA7) 10) (setq AAA6 (append AAA6 (list (cdr AAA7)))))
(setq AAA5 (1+ AAA5)))

(SETQ P1 (nth 0 AAA6))
(SETQ P3 (nth 2 AAA6))

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

(setq AAA2 (1+ AAA2)) )

)

(DEFUN C:SSU ()
(SETVAR "CMDECHO" 0)

(setq AAA1 (ssget '((0 . "LWPOLYLINE"))))
(setq AAA2 0)
(repeat (sslength AAA1)
(setq AAA3 (ssname AAA1 AAA2))
(setq AAA4 (entget AAA3))
(setq AAA5 0)
(setq AAA6 (list))
(repeat (length AAA4)
(setq AAA7 (nth AAA5 AAA4))
(if (= (car AAA7) 10) (setq AAA6 (append AAA6 (list (cdr AAA7)))))
(setq AAA5 (1+ AAA5)))

(SETQ P1 (nth 0 AAA6))
(SETQ P3 (nth 2 AAA6))

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

(setq AAA2 (1+ AAA2)) )

)

Kent1Cooper · ‎12-13-2016

@107199 wrote:

.... the non ortho ones which is the most common case in my project so is there a way to deal with this?

Try this [again, lightly tested, but it seems to work]:

Spoiler

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

(defun SS (blkname / *error* ssia doc svnames svvals P1 rectss n P3)

(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 (/ delta LL NX NY DS1 DS2); = SS Insert & Array
    (setq
      delta (mapcar 'abs (mapcar '- P3 P1)); differences in XYZ list
      LL (mapcar 'min P1 P3)
        ; Lower Left regardless of pick order or Pline start or direction
      NX (+ (fix (/ (car delta) 4600)) 1)
      NY (+ (fix (/ (cadr delta) 4600)) 1)
      DS1 (/ (car delta) NX)
      DS2 (/ (cadr delta) NY)
    ); setq
    (command
      "_.insert" blkname "_none" (mapcar '+ LL (list (/ DS1 2) (/ DS2 2))) "" "" ""
      "_.array" "_last" "" "_r" NY NX
    ); command [leaves it in Array awaiting spacing(s)
    (cond
      ((= NX 1) (command DS2))
      ((= NY 1) (command DS1))
      (T (command DS2 DS1))
    ); 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 "Select"); allows S as input to (getpoint) function, instead of point pick
(setq P1 (getpoint "\nFirst Corner of rectangular area for Sprinklers, or [Select]: "))
    ; [if in non-World UCS, returns in current UCS coordinates, not in WCS]
(if (= P1 "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*
              P1 (trans (vlax-curve-getPointAtParam rect 0) 0 1); starting vertex
              P3 (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 P3 (getcorner P1 "\nOpposite Corner: "))
      (mapcar 'setvar svnames '(0 0 0 0)); also turn off Osnap, blips
      (ssia); run the subroutine to Insert and 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)

(setvar 'cmdecho 0)(command "_.layer" "_make" "M-FIRE-SYMB-P" "_color" "2" "" "")(setvar 'cmdecho 1)(vl-load-com) (defun SS (blkname / *error* ssia doc svnames svvals P1 rectss n P3) (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 (/ delta LL NX NY DS1 DS2); = SS Insert & Array (setq delta (mapcar 'abs (mapcar '- P3 P1)); differences in XYZ list LL (mapcar 'min P1 P3) ; Lower Left regardless of pick order or Pline start or direction NX (+ (fix (/ (car delta) 4600)) 1) NY (+ (fix (/ (cadr delta) 4600)) 1) DS1 (/ (car delta) NX) DS2 (/ (cadr delta) NY) ); setq (command "_.insert" blkname "_none" (mapcar '+ LL (list (/ DS1 2) (/ DS2 2))) "" "" "" "_.array" "_last" "" "_r" NY NX ); command [leaves it in Array awaiting spacing(s) (cond ((= NX 1) (command DS2)) ((= NY 1) (command DS1)) (T (command DS2 DS1)) ); 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 "Select"); allows S as input to (getpoint) function, instead of point pick (setq P1 (getpoint "\nFirst Corner of rectangular area for Sprinklers, or [Select]: ")) ; [if in non-World UCS, returns in current UCS coordinates, not in WCS] (if (= P1 "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* P1 (trans (vlax-curve-getPointAtParam rect 0) 0 1); starting vertex P3 (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 P3 (getcorner P1 "\nOpposite Corner: ")) (mapcar 'setvar svnames '(0 0 0 0)); also turn off Osnap, blips (ssia); run the subroutine to Insert and 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)

It changes the UCS to match each Polyline [whether orthogonal or not], and uses (trans) functions to get the correctly-adjusted coordinate values from the corners for the various calculations and insertion point. It also adds *error* handling, and is slightly re-arranged [e.g. the (ssia) function is defined inside the (ss) function so it can be localized].

Kent Cooper, AIA

Kent1Cooper · ‎12-13-2016

@salman_majgaonkar wrote:

....

(setq AAA4 (entget AAA3))
(setq AAA5 0)
(setq AAA6 (list))
(repeat (length AAA4)
(setq AAA7 (nth AAA5 AAA4))
(if (= (car AAA7) 10) (setq AAA6 (append AAA6 (list (cdr AAA7)))))
(setq AAA5 (1+ AAA5)))

(SETQ P1 (nth 0 AAA6))
(SETQ P3 (nth 2 AAA6))

....

That seems a far more convoluted way of getting two corners of a Polyline rectangle than the (vlax-curve-getPointAtParam) approach. But if you have some reason to really want to get them from the vertex [10-code] entries in the entity data list, here's a more concise way to do that, eliminating the need for the AAA5 and AAA7 variables entirely:

....

(setq

AAA4 (entget AAA3)

AAA6 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) AAA4))

P1 (nth 0 AAA6)

P3 (nth 2 AAA6)

); setq

....

The (vl-remove-if-not ...) function pulls only the vertex entries ouf of the entity data list, and the (mapcar 'cdr ...) function strips the 10 off the beginning of each.

By the way, this:

(setq AAA6 (list))

serves no purpose. It returns nil, not some kind of "empty list" that can be added to [there's no such thing as an empty list -- just nothingness]. You can omit it entirely, and using (cons) or (append) to add to a non-existent variable will successfully start a list with the first added element. The inclination to try to start an "empty list" may come from the fact that in the case of a text string or a selection set, you can't add to them [with (strcat) or (ssadd)] unless you start one [which can be empty] first. But the same is not true for lists.

[Also, the suggested code doesn't allow the User the option to pick two points for the corners as in the OP's original routine, but limits them to only selecting existing Polyline objects. Nor does it restrict the selection of Polylines by any criteria, such as number of vertices, or whether they're closed, so you could get unexpected sprinklers drawn in the area of unintended objects, for example if you grab a windowed area, and happen to catch any Revclouds or Donuts or something in it. Mine doesn't test for everything, but at least limits it to 4-vertex closed ones -- it could be made to also verify whether they're actually rectangular, if desired.]

Kent Cooper, AIA

Kent1Cooper · ‎12-13-2016

@107199 wrote:

....

....
(DEFUN C:SSP ()
....
(COMMAND "-layer" "m" "M-FIRE-SYMB-P" "c" "2" "" "")
....
(DEFUN C:SSU ()
....
(COMMAND "-layer" "m" "M-FIRE-SYMB-P" "c" "2" "" "")
....

It's now occurring to me....

I incorporated the making of that Layer into my code, outside the separate command definitions, because it was the same in both in the original Post. But now I'm wondering whether that was a copying-but-not-editing mistake in your code, and whether the P in the Layer name in the SSU command ought to be a U instead, so that you have different Layers for the two head types, not just separate Blocks.

If so, the Layer name could easily be made another argument in the SSP and SSU commands, along with the Block name, and the Layer-making put into each command definition. Or the outside-the-commands Layer part at the beginning could make both Layers, and setting the current Layer to one or the other could be inside each command. [But maybe you wouldn't want that, if many installations could involve only one type, with no need for the other type's Layer.]

Another approach would be to have just the letter "P" or "U" as the one argument in each command, and use (strcat) to put that into both the Layer name and the Block name in each.

Kent Cooper, AIA

Kent1Cooper · ‎12-13-2016

@Kent1Cooper wrote:

....

(defun SS (blkname / *error* ssia doc svnames svvals P1 rectss n P3)

....

Add a missing variable to that localized-variable list:

(defun SS (blkname / *error* ssia doc svnames svvals P1 rectss n ucschanged P3)

Kent Cooper, AIA

107199 · ‎12-14-2016

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

(defun SS (blkname / *error* ssia doc svnames svvals P1 rectss n ucschanged P3)

  (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 (/ delta LL NX NY DS1 DS2); = SS Insert & Array
    (setq
      delta (mapcar 'abs (mapcar '- P3 P1)); differences in XYZ list
      LL (mapcar 'min P1 P3)
        ; Lower Left regardless of pick order or Pline start or direction
      NX (+ (fix (/ (car delta) dis)) 1)
      DS1 (/ (car delta) NX)
      DSS1 (/ area DS1)
      NY (+ (fix (/ (cadr delta) DSS1)) 1)
      DS2 (/ (cadr delta) NY)
    ); setq
    (command
      "_.insert" blkname "_none" (mapcar '+ LL (list (/ DS1 2) (/ DS2 2))) "" "" ""
      "_.array" "_last" "" "_r" NY NX
    ); command [leaves it in Array awaiting spacing(s)
    (cond
      ((= NX 1) (command DS2))
      ((= NY 1) (command DS1))
      (T (command DS2 DS1))
    ); 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 "Light Ordinary Extra")
  (setq haz (getpoint "\nSpeciefy Space Hazard Type [Light/Ordinary/Extra]: "))
  (if (= haz "light")
       (setq
	dis 4600
        area 21000000
	)
   (progn

     (if (= haz "Ordinary")
       (setq
        dis 4600
        area 12000000
       )
      )
     (progn
     (if (= haz "Extra")
       (setq
        dis 3700
        area 9000000
       )
     )
   )
  )
  )
  (initget "Select"); allows S as input to (getpoint) function, instead of point pick
  (setq P1 (getpoint "\nFirst Corner of rectangular area for Sprinklers, or [Select]: "))
    ; [if in non-World UCS, returns in current UCS coordinates, not in WCS]
  (if (= P1 "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*
              P1 (trans (vlax-curve-getPointAtParam rect 0) 0 1); starting vertex
              P3 (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 P3 (getcorner P1 "\nOpposite Corner: "))
      (mapcar 'setvar svnames '(0 0 0 0)); also turn off Osnap, blips
      (ssia); run the subroutine to Insert and 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)

i've made a small modification to the code but i don't know where is the problem?

Kent1Cooper · ‎12-15-2016

@107199 wrote:

i've made a small modification to the code but i don't know where is the problem?

Use (getkword) rather than (getpoint) as a partner for (initget) for the 'haz' variable. It may work with (getpoint), but if the User happens to actually pick a point, or type a number, something unintended will be returned, whereas with (getkword), it will completely ignore point picks, and will ask again for invalid typed input. What it returns will be the complete word exactly as in the (initget) argument, regardless of in what case the User typed the option letter, or whether they typed only the initial or more of the word. That means your check on whether it's "light" will fail, because the return will be "Light". I would also use a (cond) function rather than a series of nested (if) functions -- this kind of thing is exactly what (cond) is for -- though that should not make a difference in whether it works.

....
  (initget "Light Ordinary Extra")
  (setq haz (getkword "\nSpecify Space Hazard Type [Light/Ordinary/Extra]: "))
  (cond
    ((= haz "Light")
      (setq
        dis 4600
        area 21000000
      )
    )
    ((= haz "Ordinary")
      (setq
        dis 4600
        area 12000000
      )
    )
    ((= haz "Extra")
      (setq
        dis 3700
        area 9000000
      )
    )
  ); cond
....

Kent Cooper, AIA

107199 · ‎12-15-2016

still there is a problem ,

the problem is when pick a rect. make a different distribution away from picking left and right points shown in the below pic:

https://postimg.org/image/dye80prev/

Note : the maximum dis. is 4600 when light , ordinary and 3700 in extra hazard .

Kent1Cooper · ‎12-15-2016

Since the spacings can be farther from equal with your different determination of spacing in the Y direction, it matters which way is X and which is Y. And since the pick-a-Polyline approach aligns the UCS with the Polyline, which way ends up being X and which way Y depends on how the Polyline was drawn.

I suppose it would be possible to check whether a rectangle is orthogonally oriented, and if it is, don't change the UCS, in which case you should get the same result as when picking corners. Or, should it perhaps always figure "X" elements relative to the longer dimension of the rectangle, and "Y" the shorter one, or the reverse?

Kent Cooper, AIA

107199 · ‎12-15-2016

i think it could be made if X is related to the longer one

Community

very important lisp

very important lisp

very important lisp