TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on February 11, 2015, 08:02:15 AM

Title: Trouble - Need Assistance
Post by: V-Man on February 11, 2015, 08:02:15 AM
Taken from http://www.theswamp.org/index.php?topic=48753.0 (http://www.theswamp.org/index.php?topic=48753.0) , I am trying to put a little spin on this. We use wide flange beams for columns and they are nothing more than a closed lwpolyline (not a block). This routine does work and reports on each column the size of the column in the "X" and "Y" direction. Having the dimensions for the wide flange columns is great but it would be more powerful if it also reported the actual name of the column. For instance, W6x12 or w10x12 etc...

So basically for a W6x12 the dims are (X)4.0 and (Y)6.0
and a W10x12 the dims would be (X)4.0 and (Y)9.875

The routine already reports the (X) and (Y) dimensions of all columns in the drawing, I just want it to also add the name of the column based on the size. I do have the sizes of all of the wide flanged beams that we use. I am just having loads of issues trying to modify this to do what I want.

Code: [Select]
(defun c:CCS ( / mn mx peditaccept plinecnt pntnX pntxX ss)
  (vl-load-com)
  (command "-layer" "on" "Defpoints" "thaw" "Defpoints" "")
  (if
    (setq ss (ssget "_X" '((0 . "Arc,Line,lwpolyline")
 (8 . "S-COLS,A-WALL-SHEL-EXST"))))
    (progn
      (setq peditaccept (getvar 'peditaccept))
      (setvar 'peditaccept 1)
      (setvar 'peditaccept peditaccept)
    )
  )
  (setq plinecnt 0)
  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE")(8 . "S-COLS,A-WALL-SHEL-EXST"))))
    (repeat (sslength ss)
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss plinecnt)) 'mn 'mx)
      (setq mn (vlax-safearray->list mn))
      (setq mx (vlax-safearray->list mx))
      (setq pntnX (nth 0 mn))  (setq pntnY (nth 1 mn))
      (setq pntxX (nth 0 mx))  (setq pntxY (nth 1 mx))
           (setq dvx (- pntxX pntnX));added
           (setq dvy (- pntxY pntnY));added
           (scheck);added
     ; (InsText (strcat "Size" " = "(rtos (- pntxX pntnX) 4 16) " x " (rtos (- pntxY pntnY) 4 16)) (list pntxX pntnY 0.0));original code
     (InsText (strcat "Size" " = "(rtos (- pntxX pntnX) 4 16) " x " (rtos (- pntxY pntnY) 4 16) " - " dvSize) (list pntxX pntnY 0.0));modified
      (setq plinecnt (1+ plinecnt))
    )
  )
);end defun
(defun InsText ( BlkName pt / )
  (entmakex
    (list
      (cons 0  "TEXT")
      (cons 8  "Defpoints")
      (cons 1  BlkName)
      (cons 10 Pt)
      (cons 40 5)
      (cons 41 0.8)
    )
  )
);end defun
The output currently for each column is as follows:

Size = 4" x 6"

Size = 4" x 9 7/8"

I would like it to be...
Size = 4" x 6" - W6x12

Size = 4" x 9 7/8" - W10x12

etc..

Here is a snippet of my column sizes..
Code: [Select]
(defun scheck ()
(if
    (and (= dvx 4.0) (= dvy 4.125)
    )
         (setq dvSize "W4x13")
         (setq dvSize "nil")
)
(if
    (and (= dvx 5.0) (= dvy 5.0)
    )
         (setq dvSize "W5x16")
         (setq dvSize "nil")
)
(if
    (and (= dvx 5.0) (= dvy 5.125)
    )
         (setq dvSize "W5x18.5")
         (setq dvSize "nil")
)
(if
    (and (= dvx 5.0) (= dvy 5.125)
    )
         (setq dvSize "W5x19")
         (setq dvSize "nil")
)
(if
    (and (= dvx 4.0) (= dvy 5.875)
    )
         (setq dvSize "W6x9")
         (setq dvSize "nil")
)
)
I hope that I am not asking too much. I am just stuck. Any guidance or help would be great.

Thanks,
Title: Re: Trouble - Need Assistance
Post by: kpblc on February 11, 2015, 08:33:05 AM
Use cond function. Or you can use associated lists - I think it will be more functionality.
Should i write code sample?
Title: Re: Trouble - Need Assistance
Post by: ronjonp on February 11, 2015, 08:38:48 AM
Something like this:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:ccs (/ instext scheck dvx dvy mn mx peditaccept plinecnt pntnx pntny pntxx pntxy ss)
  3.   (defun instext (text pt /)
  4.     (entmakex (list (cons 0 "TEXT")
  5.                     (cons 8 "Defpoints")
  6.                     (cons 1 text)
  7.                     (cons 10 pt)
  8.                     (cons 40 5)
  9.                     (cons 41 0.8)
  10.               )
  11.     )
  12.   )                                     ;end defun
  13.   (defun scheck (dvx dvy)
  14.     (cond ((and (= dvx 4.0) (= dvy 4.125)) "W4x13")
  15.           ((and (= dvx 5.0) (= dvy 5.0)) "W5x16")
  16.           ((and (= dvx 5.0) (= dvy 5.125)) "W5x18.5")
  17.           ((and (= dvx 5.0) (= dvy 5.125)) "W5x19")
  18.           ((and (= dvx 4.0) (= dvy 5.875)) "W6x9")
  19.           ("nil")
  20.     )
  21.   )
  22.   ;; (alert (scheck 5.0 5.0))
  23.   (command "-layer" "on" "Defpoints" "thaw" "Defpoints" "")
  24.   (if (setq ss (ssget "_X" '((0 . "Arc,Line,lwpolyline") (8 . "S-COLS,A-WALL-SHEL-EXST"))))
  25.     ;; What is going on here?
  26.     (progn (setq peditaccept (getvar 'peditaccept))
  27.            (setvar 'peditaccept 1)
  28.            (setvar 'peditaccept peditaccept)
  29.     )
  30.   )
  31.   (setq plinecnt 0)
  32.   (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "S-COLS,A-WALL-SHEL-EXST"))))
  33.     (repeat (sslength ss)
  34.       (vla-getboundingbox (vlax-ename->vla-object (ssname ss plinecnt)) 'mn 'mx)
  35.       (setq mn (vlax-safearray->list mn))
  36.       (setq mx (vlax-safearray->list mx))
  37.       (setq pntnx (car mn))
  38.       (setq pntny (cadr mn))
  39.       (setq pntxx (car mx))
  40.       (setq pntxy (cadr mx))
  41.       (setq dvx (- pntxx pntnx))        ;added
  42.       (setq dvy (- pntxy pntny))        ;added
  43.                                         ; (InsText (strcat "Size" " = "(rtos (- pntxX pntnX) 4 16) " x " (rtos (- pntxY pntnY) 4 16)) (list pntxX pntnY 0.0));original code
  44.       (instext (strcat "Size" " = " (rtos dvx 4 16) " x " (rtos dvy 4 16) " - " (scheck dvx dvy))
  45.                (list pntxx pntny 0.0)
  46.       )                                 ;modified
  47.       (setq plinecnt (1+ plinecnt))
  48.     )
  49.   )
  50.   (princ)
  51. )                                       ;end defun
  52.  
Title: Re: Trouble - Need Assistance
Post by: V-Man on February 11, 2015, 09:43:43 AM
Quote
Use cond function. Or you can use associated lists - I think it will be more functionality.
Should i write code sample?

A code sample would be great if possible.
Title: Re: Trouble - Need Assistance
Post by: kpblc on February 11, 2015, 10:01:33 AM
By cond function:
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun c:css (/ adoc *error* fun_colname)
  4.  
  5.   (defun fun_colname (minp maxp / _l _h prec)
  6.     (setq _l   (apply (function -) (mapcar (function car) (list minp maxp)))
  7.           _h   (apply (function -) (mapcar (function cadr) (list minp maxp)))
  8.           prec 1e-6
  9.           ) ;_ end of setq
  10.     (strcat "Size = "
  11.             (rtos _l 4)
  12.             " x "
  13.             (rtos _h 4)
  14.             " - "
  15.             (cond
  16.               ((and (equal _l 4. prec) (equal _h 4.125 prec)) "W4x13")
  17.               ((and (equal _l 5. prec) (equal _h 5. prec)) "W5x16")
  18.               ((and (equal _l 5. prec) (equal _h 5.125 prec)) "W5x18.5")
  19.               ((and (equal _l 4. prec) (equal _h 5.875 prec)) "W5x19")
  20.               (t "* NOT DEFINED *")
  21.               ) ;_ end of cond
  22.             ) ;_ end of strcat
  23.     ) ;_ end of defun
  24.  
  25.   (defun *error* (msg)
  26.     (vla-endundomark adoc)
  27.     (princ msg)
  28.     (princ)
  29.     ) ;_ end of defun
  30.  
  32.   (foreach ent (mapcar (function vlax-ename->vla-object)
  33.                        ((lambda (/ selset item tab)
  34.                           (setq selset (ssget "_X" '((0 . "LWPOLYLINE") (8 . "S-COLS,A-WALL-SHEL-EXST"))))
  35.                           (repeat (setq tab  nil
  36.                                         item (sslength selset)
  37.                                         ) ;_ end setq
  38.                             (setq tab (cons (ssname selset (setq item (1- item))) tab))
  39.                             ) ;_ end of repeat
  40.                           ) ;_ end of lambda
  41.                         )
  42.                        ) ;_ end of mapcar
  43.     (entmakex (list '(0 . "TEXT")
  44.                     '(8 . "Defpoints")
  45.                     (cons 10 (list (car minp) (cadr minp) 0.))
  46.                     (cons 1 (fun_colname minp maxp)
  47.                     '(40 . 5)
  48.                     '(41 . 0.8)
  49.                     '(210 0. 0. 1.)
  50.                     ) ;_ end of list
  51.               ) ;_ end of entmakex
  52.     ) ;_ end of foreach
  53.   (vla-endundomark adoc)
  54.   (princ)
  55.   ) ;_ end of defun
Using associate list (as a sample. i can't test code):
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun c:css (/ adoc *error* fun_colname)
  4.  
  5.   (defun fun_colname (minp maxp / _l _h prec)
  6.     (setq _l   (apply (function -) (mapcar (function car) (list minp maxp)))
  7.           _h   (apply (function -) (mapcar (function cadr) (list minp maxp)))
  8.           prec 1e-6
  9.           ) ;_ end of setq
  10.     (strcat "Size = "
  11.             (rtos _l 4)
  12.             " x "
  13.             (rtos _h 4)
  14.             " - "
  15.             (cond
  16.               ((cdr (assoc (strcat (atoi (fix (* 1000 _l))) "x" (atoi (fix (* 1000 _h))))
  17.                            '(("4000x4120" . "W4x13")
  18.                              ("5000x5000" . "W5x16")
  19.                              ("5000x5125" . "W5x18.5")
  20.                              ("4000x5875" . "W5x19")
  21.                              )
  22.                            ) ;_ end of assoc
  23.                     ) ;_ end of cdr
  24.                )
  25.               (t "* NOT DEFINED *")
  26.               ) ;_ end of cond
  27.             ) ;_ end of strcat
  28.     ) ;_ end of defun
  29.  
  30.   (defun *error* (msg)
  31.     (vla-endundomark adoc)
  32.     (princ msg)
  33.     (princ)
  34.     ) ;_ end of defun
  35.  
  37.   (foreach ent (mapcar (function vlax-ename->vla-object)
  38.                        ((lambda (/ selset item tab)
  39.                           (setq selset (ssget "_X" '((0 . "LWPOLYLINE") (8 . "S-COLS,A-WALL-SHEL-EXST"))))
  40.                           (repeat (setq tab  nil
  41.                                         item (sslength selset)
  42.                                         ) ;_ end setq
  43.                             (setq tab (cons (ssname selset (setq item (1- item))) tab))
  44.                             ) ;_ end of repeat
  45.                           ) ;_ end of lambda
  46.                         )
  47.                        ) ;_ end of mapcar
  48.     (entmakex (list '(0 . "TEXT")
  49.                     '(8 . "Defpoints")
  50.                     (cons 10 (list (car minp) (cadr minp) 0.))
  51.                     (cons 1 (fun_colname minp maxp)
  52.                     '(40 . 5)
  53.                     '(41 . 0.8)
  54.                     '(210 0. 0. 1.)
  55.                     ) ;_ end of list
  56.               ) ;_ end of entmakex
  57.     ) ;_ end of foreach
  58.   (vla-endundomark adoc)
  59.   (princ)
  60.   ) ;_ end of defun
  61.  
Title: Re: Trouble - Need Assistance
Post by: ronjonp on February 11, 2015, 10:13:34 AM
Quote from: V-Man on February 11, 2015, 09:43:43 AM
Quote
Use cond function. Or you can use associated lists - I think it will be more functionality.
Should i write code sample?

A code sample would be great if possible.
Like THIS (http://www.theswamp.org/index.php?topic=48847.msg539666#msg539666) ? :)
Title: Re: Trouble - Need Assistance
Post by: V-Man on February 11, 2015, 12:00:13 PM
Thanks ronjonp. Your code works great and that's what I am using. I just wanted to see what code sample kpblc would come up with. I will studdy both approach's. Thanks again guys for the assistance.
Title: Re: Trouble - Need Assistance
Post by: CAB on February 11, 2015, 02:32:24 PM
FYI, Some what related topic:
http://www.theswamp.org/index.php?topic=47517.0