Topic: Help with a routine

[yiyorebel]

hello all, I'm new to AutoLISP and I'd like to see if I can help with a routine that I like to do, I have only one part (the easiest), I attach a dwg to see what my idea.
I hope I can help.
Thank you very much.
Juan Pablo

[LE3]

quieres dibujar secciones de zapatas?
do you want to draw foundation sections?

[yiyorebel]

Hi, thanks for answering le3, my idea is to draw the section of the foundation with its bars and stirrups in the pedestal, to draw the section in elevation and plant like this in the dwg. Do not know if it is very difficult to make a routine to draw everything that I put an example?. Sorry for the English, I'm using google translator.
Thank you.

[CAB]

Welcome to the Swamp.
Yes it can be done without much trouble but will take a little time to put the routine together.

[yiyorebel]

Thank you very much for responding Cab, thanks for the welcome.
I hope you can do something, anything more to do my little routine, it will be an improvement.
Thanks

[CAB]

I'll give you a start. This method is easier to follow, i think.
Perhaps it will work for you. Hope you read English as I changed the prompts.
Also use (setq debug t) if you want to test without re-entering the length during testing.
 

Code: [Select]

;; Rutina para dibujar corte fundacion.
(defun c:Corfun (/ pt ACDOC BASE_PT DOWN H_BASE H_PED LEFT NORM PLINEOBJ PT
                 PT_LIST RIGHT SPACE UP W_BASE W_PED rbClear1 rbClear2 overlap)
  (vl-load-com)

  ;;  by CAB 03/22/2009
  ;;  Expects pts to be a list of 2D or 3D points
  ;;  Returns new pline object
  (defun makePline (spc pts / norm elv pline)
    (setq norm (trans '(0 0 1) 1 0 T)
          elv  (caddr (trans (car pts) 1 norm))
    )
    (setq pline
           (vlax-invoke Spc
             'addLightWeightPolyline
             (apply 'append
                    (mapcar '(lambda (pt)
                               (setq pt (trans pt 1 norm))
                               (list (car pt) (cadr pt))
                             )
                            pts)))
    )
    (vla-put-Elevation pline elv)
    (vla-put-Normal pline (vlax-3d-point norm))
    pline
  )


  ;;=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))

  ;;  CAB 2009 - this may be better
  ;;  http://www.theswamp.org/index.php?topic=31324.msg368864#msg368864
  ;;  get current space - ActiveSpace
  (setq Space
         (if (= 1 (getvar "CVPORT"))
           (vla-get-PaperSpace AcDoc)
           (vla-get-ModelSpace AcDoc)
         )
  )

  (if debug
    (setq h_base 50
          h_ped  40
          w_base 120
          w_ped  42
          )
    (progn
  (setq h_base (getdist "\nFoundation Height: ")) ; "\nAltura fundacion: "
  (setq h_ped  (getdist "\nPedestal Height: "))   ; "\nAltura pedestal: "
  (setq w_base (getdist "\nFoundation Width: "))  ; "\nAncho fundacion: "
  (setq w_ped  (getdist "\nPedestal Width: "))    ; "\nAncho pedestal: "
  )) ; debug

  (setq base_pt (getpoint "\nPick base point for the section.")) ; "\nPunto de base para el trazado: "
 
  (setq up    (/ pi 2)                  ; encima de
        left  pi                        ; izquierdo
        right 0.0                       ; la derecha
        down  (* pi 1.5)                ; abajo
  )

  ;;  Main Section Outline   ===================================
 
  ;; create a point list starting at the base point and go counter clockwise
  ;; use polar and a relative last point to get the next point
  (setq pt_list (list base_pt
                      (setq pt (polar base_pt right w_base))
                      (setq pt (polar pt up h_base))
                      (setq pt (polar pt left (/ (- w_base w_ped) 2.)))
                      (setq pt (polar pt up h_ped))
                      (setq pt (polar pt left w_ped))
                      (setq pt (polar pt down h_ped))
                      (setq pt (polar pt left (/ (- w_base w_ped) 2.)))
                )
  )

  (setq plineObj (makePline Space pt_list))
  (vla-put-Closed plineObj :vlax-true)
  (vla-put-Layer plineObj "FUNDACIONES")
  (vla-put-Color plineObj AcYellow)
  ;;(vla-put-Linetype plineObj "HIDDEN")

  (setq subBase 5.0) ; height
  ;;   Sub base  =================================================
  (setq pt_list (list base_pt
                      (setq pt (polar base_pt down subBase))
                      (setq pt (polar pt right w_base))
                      (setq pt (polar pt up subBase))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Closed plineObj :vlax-true)
  (vla-put-Layer plineObj "FUNDACIONES")
  (vla-put-Color plineObj AcYellow)

  (setq rbClear1 4.) ; rebar clearance   separación del rebar
  ;;    Bottom Rebar   ==========================================
  (setq pt_list (list (setq pt (polar (polar base_pt up (+ rbClear1 11.39)) right rbClear1))
                      (setq pt (polar pt down 11.39))
                      (setq pt (polar pt right (- w_base rbClear1 rbClear1)))
                      (setq pt (polar pt up 11.39))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Layer plineObj "CORTES")
  (vla-put-Color plineObj AcGreen)

  (setq rbClear2 3.) ; rebar clearance   separación del rebar
  (setq overlap 7.5) ; lap past center   regazo más allá del centro
  ;;================================================================
  (setq pt_list (list (setq pt (polar (polar base_pt right (- (/ w_base 2.) overlap)) up 2))
                      (setq pt (polar pt right (+ overlap (-(/ w_ped 2.)rbClear2))))
                      (setq pt (polar pt up (-(+ h_base h_ped) rbClear2 2)))
                      (setq pt (polar pt left (- w_ped rbClear2 rbClear2)))
                      (setq pt (polar pt down (-(+ h_base h_ped) rbClear2 2.5)))
                      (setq pt (polar pt right (+ overlap (-(/ w_ped 2.)rbClear2))))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Layer plineObj "CORTES")
  (vla-put-Color plineObj AcYellow)
 

  (princ)
)

[yiyorebel]

Cab, which have easy to program, you know I have a routine that makes sections of reinforced concrete beams, perhaps could be adapted to make the section of the pedestal, but that routine has a problem with the dim ... I work as model I give the scale to the window, so that the drawing is to scale papespace appropriate (not if I explain it), I use styles dim (20 - 25 - 50 - 75 - 100), the ideal would be that the routine could work with these styles of dim. Also I have another routine that is for the reinforcement of foundations, drawing on plant, would also have to adapt, I use cad 2010 and I have not been able to use.I hope I can adapt and make a great routine sections of foundation.
I hope not too much trouble all I need.
Thank you again.

[CAB]

This may help with the styles.

Code: [Select]

;; Rutina para dibujar corte fundacion.
(defun c:Corfun (/ pt ACDOC BASE_PT DOWN H_BASE H_PED LEFT NORM PLINEOBJ PT
                 PT_LIST RIGHT SPACE UP W_BASE W_PED rbClear1 rbClear2 overlap)
  (vl-load-com)

  ;;  by CAB 03/22/2009
  ;;  Expects pts to be a list of 2D or 3D points
  ;;  Returns new pline object
  (defun makePline (spc pts / norm elv pline)
    (setq norm (trans '(0 0 1) 1 0 T)
          elv  (caddr (trans (car pts) 1 norm))
    )
    (setq pline
           (vlax-invoke Spc
             'addLightWeightPolyline
             (apply 'append
                    (mapcar '(lambda (pt)
                               (setq pt (trans pt 1 norm))
                               (list (car pt) (cadr pt))
                             )
                            pts)))
    )
    (vla-put-Elevation pline elv)
    (vla-put-Normal pline (vlax-3d-point norm))
    pline
  )

  (defun AddDimRotated  (spc Node1 Node2 TextPt RotAng / DimObj)
  (if (not (vl-catch-all-error-p
             (setq DimObj
               (vl-catch-all-apply 'vla-AddDimRotated
                  (list spc
                        (vlax-3d-point Node1)
                        (vlax-3d-point Node2)
                        (vlax-3d-point TextPt)
                        RotAng)))))
    DimObj))
 
  ;;=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))

  ;;  CAB 2009 - this may be better
  ;;  http://www.theswamp.org/index.php?topic=31324.msg368864#msg368864
  ;;  get current space - ActiveSpace
  (setq Space
         (if (= 1 (getvar "CVPORT"))
           (vla-get-PaperSpace AcDoc)
           (vla-get-ModelSpace AcDoc)
         )
  )

  (if debug
    (setq h_base 50
          h_ped  40
          w_base 120
          w_ped  42
          )
    (progn
  (setq h_base (getdist "\nFoundation Height: ")) ; "\nAltura fundacion: "
  (setq h_ped  (getdist "\nPedestal Height: "))   ; "\nAltura pedestal: "
  (setq w_base (getdist "\nFoundation Width: "))  ; "\nAncho fundacion: "
  (setq w_ped  (getdist "\nPedestal Width: "))    ; "\nAncho pedestal: "
  )) ; debug

  (setq base_pt (getpoint "\nPick base point for the section.")) ; "\nPunto de base para el trazado: "
 
  (setq up    (/ pi 2)                  ; encima de
        left  pi                        ; izquierdo
        right 0.0                       ; la derecha
        down  (* pi 1.5)                ; abajo
  )

  ;;  Main Section Outline   ===================================
 
  ;; create a point list starting at the base point and go counter clockwise
  ;; use polar and a relative last point to get the next point
  (setq pt_list (list base_pt
                      (setq pt (polar base_pt right w_base))
                      (setq pt (polar pt up h_base))
                      (setq pt (polar pt left (/ (- w_base w_ped) 2.)))
                      (setq pt (polar pt up h_ped))
                      (setq pt (polar pt left w_ped))
                      (setq pt (polar pt down h_ped))
                      (setq pt (polar pt left (/ (- w_base w_ped) 2.)))
                )
  )

  (setq plineObj (makePline Space pt_list))
  (vla-put-Closed plineObj :vlax-true)
  (vla-put-Layer plineObj "FUNDACIONES")
  (vla-put-Color plineObj AcYellow)
  ;;(vla-put-Linetype plineObj "HIDDEN")

  (setq subBase 5.0) ; height
  ;;   Sub base  =================================================
  (setq pt_list (list base_pt
                      (setq pt (polar base_pt down subBase))
                      (setq pt (polar pt right w_base))
                      (setq pt (polar pt up subBase))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Closed plineObj :vlax-true)
  (vla-put-Layer plineObj "FUNDACIONES")
  (vla-put-Color plineObj AcYellow)

  (setq rbClear1 4.) ; rebar clearance   separación del rebar
  ;;    Bottom Rebar   ==========================================
  (setq pt_list (list (setq pt (polar (polar base_pt up (+ rbClear1 11.39)) right rbClear1))
                      (setq pt (polar pt down 11.39))
                      (setq pt (polar pt right (- w_base rbClear1 rbClear1)))
                      (setq pt (polar pt up 11.39))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Layer plineObj "CORTES")
  (vla-put-Color plineObj AcGreen)

  (setq rbClear2 3.) ; rebar clearance   separación del rebar
  (setq overlap 7.5) ; lap past center   regazo más allá del centro
  ;;================================================================
  (setq pt_list (list (setq pt (polar (polar base_pt right (- (/ w_base 2.) overlap)) up 2))
                      (setq pt (polar pt right (+ overlap (-(/ w_ped 2.)rbClear2))))
                      (setq pt (polar pt up (-(+ h_base h_ped) rbClear2 2)))
                      (setq pt (polar pt left (- w_ped rbClear2 rbClear2)))
                      (setq pt (polar pt down (-(+ h_base h_ped) rbClear2 2.5)))
                      (setq pt (polar pt right (+ overlap (-(/ w_ped 2.)rbClear2))))
                      )
        )
  (setq plineObj (makePline Space pt_list))
  (vla-put-Layer plineObj "CORTES")
  (vla-put-Color plineObj AcYellow)


  ;;  Add Dim (Base Width)
  (setq dimObj
           (AddDimRotated Space
                   (setq pt (polar base_pt down subBase))
                   (polar pt right w_base)
                   (polar (polar pt right (/ w_base 2.)) down 35.)
                   0.0))
  (vla-put-stylename dimObj "25")

  ;;  Add Dim (Base Height)
  (setq dimObj
           (AddDimRotated Space
                   base_pt
                   (polar base_pt up h_base)
                   (polar (polar base_pt up (/ h_base 2.)) left 41.)
                   up))
  (vla-put-stylename dimObj "25")
 
  ;;  Add Dim (Ped Height)
  (setq dimObj
           (AddDimRotated Space
                   (setq pt (polar base_pt up h_base))
                   (polar pt up h_ped)
                   (polar (polar pt up (/ h_ped 2.)) left 41.)
                   up))
  (vla-put-stylename dimObj "25")
       
  ;;  Add Dim (subBase)
  (setq dimObj
           (AddDimRotated Space
                   base_pt
                   (polar base_pt down subBase)
                   (polar (polar base_pt down (/ subBase 2.)) left 41.)
                   up))
  (vla-put-stylename dimObj "25")

  ;;  Add Dim (Ped Width)
  (setq dimObj
           (AddDimRotated Space
                   (setq pt (polar (polar base_pt right (/ (- w_base w_ped) 2.)) up (+ h_ped h_base)))
                   (polar pt right w_ped)
                   (polar (polar pt right (/ w_ped 2.)) up 24.)
                   0.0))
  (vla-put-stylename dimObj "25")

 
  (princ)
)

[GDF]

Here is an old routine to look at:

Code: [Select]


(defun HATCHITC  ()
  (setq pointx (getpoint "\n* Pick inside the Beam for Hatching....*"))
  (setvar "hpname" "AR-CONC")
  (setvar "hpscale" 1)
  (command "bhatch" pointx "")
  (princ))
(defun c:CBEAM  ()
  (graphscr)
  (setq OS (getvar "osmode"))
  (setvar "osmode" 0)
  (setq COV nil)
  (setq TBNO nil)
  (setq BBNO nil)
  (setq TBSZ nil)
  (setq BBSZ nil)
  (setq BMB (getdist "\n* Enter Beam Width [12]: "))
  (setq BMD (getdist "\n* Enter Beam Depth [24]: "))
  (setq COV (getdist "\n* Enter Concrete Cover [1.5]: "))
  (if (= COV nil)
    (setq COV 1.5))
  (setq TBNO (getdist "\n* Enter Number of Top Bars [2]: "))
  (if (= TBNO nil)
    (setq TBNO 2.0))
  (setq TBNO (fix (- TBNO 1)))
  (setq TBSZ (getdist "\n* Enter Top Bar Size [#4]: "))
  (if (= TBSZ nil)
    (setq TBSZ 4.0))
  (setq TBD (/ TBSZ 8))
  (if (= TBSZ 9)
    (setq TBD (sqrt (/ (* 4 1.000 1.000) pi))))
  (if (= TBSZ 10)
    (setq TBD (sqrt (/ (* 4 1.125 1.125) pi))))
  (if (= TBSZ 11)
    (setq TBD (sqrt (/ (* 4 1.250 1.250) pi))))
  (if (= TBSZ 14)
    (setq TBD (sqrt (/ (* 4 1.500 1.500) pi))))
  (if (= TBSZ 18)
    (setq TBD (sqrt (/ (* 4 2.000 2.000) pi))))
  (setq BBNO (getdist "\n* Enter Number of Bottom Bars [2]: "))
  (if (= BBNO nil)
    (setq BBNO 2.0))
  (setq BBNO (fix (- BBNO 1)))
  (setq BBSZ (getdist "\n* Enter Bottom Bar Size [#6]: "))
  (if (= BBSZ nil)
    (setq BBSZ 6.0))
  (setq BBD (/ BBSZ 8))
  (if (= BBSZ 9)
    (setq BBD (sqrt (/ (* 4 1.000 1.000) pi))))
  (if (= BBSZ 10)
    (setq BBD (sqrt (/ (* 4 1.125 1.125) pi))))
  (if (= BBSZ 11)
    (setq BBD (sqrt (/ (* 4 1.250 1.250) pi))))
  (if (= BBSZ 14)
    (setq BBD (sqrt (/ (* 4 1.500 1.500) pi))))
  (if (= BBSZ 18)
    (setq BBD (sqrt (/ (* 4 2.000 2.000) pi))))
  (if (= BMB nil)
    (setq BMB 12))
  (if (= BMD nil)
    (setq BMD 24))
  (setq BP1 (getpoint "\n* Pick Bottom Lefthand Corner OF Beam *"))
  (setq BP2 (list (+ (car BP1) BMB) (cadr BP1)))
  (setq BP3 (list (car BP2) (+ (cadr BP1) BMD)))
  (setq BP4 (list (car BP1) (cadr BP3)))
  (command "pline" BP1 BP2 BP3 BP4 "c")
  (HATCHITC)
  (setq SP1 (list (+ (car BP1) COV) (+ (cadr BP1) COV)))
  (setq SP2 (list (- (car BP2) COV) (+ (cadr BP2) COV)))
  (setq SP3 (list (- (car BP3) COV) (- (cadr BP3) COV)))
  (setq SP4 (list (+ (car BP4) COV) (- (cadr BP4) COV)))
  (setq TB1 (list (+ (car SP4) TBD) (- (cadr SP4) TBD)))
  (setq TB2 (list (- (car SP3) TBD) (- (cadr SP3) TBD)))
  (setq TOPD (- (car TB2) (car TB1)))
  (command "donut" "0" TBD TB1 "")
  (setq INC 0)
  (repeat TBNO
    (setq INC (+ INC (/ TOPD TBNO)))
    (setq NEWPT (polar TB1 0 INC))
    (command "donut" "0" TBD NEWPT ""))
  (setq BB1 (list (+ (car SP1) BBD) (+ (cadr SP1) BBD)))
  (setq BB2 (list (- (car SP2) BBD) (+ (cadr SP2) BBD)))
  (setq BOTD (- (car BB2) (car BB1)))
  (command "donut" "0" BBD BB1 "")
  (setq INC 0)
  (repeat BBNO
    (setq INC (+ INC (/ BOTD BBNO)))
    (setq NEWPT (polar BB1 0 INC))
    (command "donut" "0" BBD NEWPT ""))
  (setq SDS (/ TBD (SQRT 2)))
  (setq S01 (list (- (car TB1) SDS) (- (cadr TB1) SDS)))
  (setq S02 (list (- (car TB1) TBD) (cadr TB1)))
  (setq S03 (list (car TB1) (+ (cadr TB1) TBD)))
  (setq S04 (list (+ (car TB1) SDS) (+ (cadr TB1) SDS)))
  (setq S05 (list (- (car TB2) SDS) (+ (cadr TB2) SDS)))
  (setq S06 (list (car TB2) (+ (cadr TB2) TBD)))
  (setq S07 (list (+ (car TB2) TBD) (cadr TB2)))
  (setq S08 (list (+ (car TB2) SDS) (- (cadr TB2) SDS)))
  (setq S09 (list (+ (car BB2) BBD) (cadr BB2)))
  (setq S10 (list (car BB2) (- (cadr BB2) BBD)))
  (setq S11 (list (car BB1) (- (cadr BB1) BBD)))
  (setq S12 (list (- (car BB1) BBD) (cadr BB1)))
  (setq S13 (polar S01 (* 1.75 PI) 3))
  (setq S14 (polar S04 (* 1.75 PI) 3))
  (setq S15 (polar S05 (* 1.25 PI) 3))
  (setq S16 (polar S08 (* 1.25 PI) 3))
  (setq S17 (list (- (car S03) TBD) (cadr S03)))
  (setq S18 (list (- (car S17) 0.5) (- (cadr S17) 0.5)))
  (setq S19 (list (car S18) (- (cadr S18) 4.0)))
  (setq S20 (list (+ (car S06) TBD) (cadr S06)))
  (setq S21 (list (+ (car S20) 0.5) (- (cadr S20) 0.5)))
  (setq S22 (list (car S21) (- (cadr S21) 4.0)))
  (command "line" S12 S02 "")
  (command "line" S03 S06 "")
  (command "line" S09 S07 "")
  (command "line" S11 S10 "")
  (command "line" S01 S13 "")
  (command "line" S04 S14 "")
  (command "line" S05 S15 "")
  (command "line" S08 S16 "")
  (command "line" S19 S18 "")
  (command "line" S17 S03 "")
  (command "line" S06 S20 "")
  (command "line" S21 S22 "")
  (command "arc" "c" TB1 S04 S03)
  (command "arc" "c" TB1 S03 S02)
  (command "arc" "c" TB1 S02 S01)
  (command "arc" "c" TB2 S08 S07)
  (command "arc" "c" TB2 S07 S06)
  (command "arc" "c" TB2 S06 S05)
  (command "arc" "c" BB1 S12 S11)
  (command "arc" "c" BB2 S10 S09)
  (command "arc" S17 "e" S18 "r" 0.5)
  (command "arc" S21 "e" S20 "r" 0.5)
  (setvar "osmode" OS)
  (command "redraw")
  (command "layer" "s" prev ""))


[ozimad]

I think dynamic block can help you. 
Its easier, and faster. Think about time/efficiency. 
I am an bridge engineer and I have a lot of foundations in my work. I use dynamic blocks for beams and foundations.
Hope it can help you.