Jump to content

Corner Bars for Foundations

Yirmeyahu

By Yirmeyahu
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Yirmeyahu Rookie

Yirmeyahu

Posted
Posted

I need help inserting the rebar block on all 90 degree corners greater than 2'-0" and have them inserted to the inside of the polygon.  Here is what I have so far.  Right now the command inserts the block on all 90 degree corners, both inside and outside of the polygon. 

(defun C:ABAR (/)
  (command "._undo" "_begin")

  (setq sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        blk "rebar"
  )
  (command "-layer" "m" "tempAB" "Color" "cyan" "" "Plot" "Plot" "" "Ltype" "continuous" "" "")

  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (8 . "Edge"))))

    (repeat (setq n (sslength ss))  ; repeat each edge

      (command "_.COPY" (ssname ss (setq n (1- n))) "" "0,0" "0,0")
      (command "_.chprop" "L" "" "LA" "tempAB" "")
      (command "_.explode" "L")

      (setq firstRun 0)
;;-+-----repeat each line of the edge     ;;;line segment iteration------------------------------------------------------------------------------------
      (repeat (setq m (sslength (setq sss (ssget "_P"))))

        (setq ent (ssname sss (setq m (1- m)))
              ppt1 (vlax-curve-getStartPoint ent)
              ppt2 (vlax-curve-getEndPoint ent)

        )  ;end_setq

        (if (= firstRun 0)
          (progn
            (setq firstRun 1)
            (setq ent2 (ssname sss (- m 1)))
            (setq ppt3 (vlax-curve-getEndPoint ent2))
            (Insert90 ppt1 ppt2 ppt3)

          )
          (progn
            (setq ent2 (ssname sss (+ m 1)))
            (setq ppt3 (vlax-curve-getEndPoint ent2))
            (Insert90 ppt1 ppt2 ppt3)
          )
        )

  
      (command "erase" ent "")       
      )
    )      ; repeat each edge ; repeat each line in exploded selection set--------------------------------------------------------------------------------
  )        ; if

  (command "-purge" "la" "tempAB" "n")
  (command "._undo" "_end")
  (princ)
)          ; defun

 

 

ronjonp Grand Master

ronjonp

Posted
Posted

Maybe post a sample drawing. That code above is also missing the function 'Insert90'.

BIGAL Grand Master

BIGAL

Posted
Posted

Rather than look at your code have you looked at a rebar package that does lots of shapes, quantities etc, just google.

Yirmeyahu Rookie

Yirmeyahu

Posted
  • Author
Posted

The polygon on the left is what the command does and the one on the right is what is needed.

 

image.thumb.png.579fa7504479f622214fbfa32b70d1a6.png

Abar.lsp

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Like ronjonp  (Insert90 ppt1 ppt2 ppt3) is missing it may be as simple as looking at the angle that is calculated.

 

Edited by BIGAL
Yirmeyahu Rookie

Yirmeyahu

Posted
  • Author
Posted

I miss copied the 1st code, I attached the entire routine with the pic above.  See Abar.lsp.  

 

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Try this, you should not check for 90 as this is for concrete slabs a architect may have a slab with a angle. Also the bar angle should be a true 90 from the internal corner angle. See images.

  

(defun C:ABAR (/ )
 (command "._undo" "_begin")
 
   (setq sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        blk "rebar"  
    )
  (command "-layer" "m" "tempAB" "Color" "cyan" "" "Plot" "Plot" "" "Ltype" "continuous" "" "")
  
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") ) ))
    
    (repeat (setq n (sslength ss)); repeat each edge
      
      (command "_.COPY" (ssname ss (setq n (1- n))) "" "0,0" "0,0")
      (command "_.chprop" "L" "" "LA" "tempAB" "")
      (command "_.explode" "L")
      
      (setq firstRun 0)
;;-+-----repeat each line of the edge     ;;;line segment iteration------------------------------------------------------------------------------------
      (repeat (setq m (sslength (setq sss (ssget "_P"))))
            
            (setq ent (ssname sss (setq m (1- m)))
                  ppt1  (vlax-curve-getStartPoint ent) 
                  ppt2  (vlax-curve-getEndPoint ent)                
                  
            );end_setq
            
              (if (= firstRun 0)
                (progn
                  (setq firstRun 1)
                  (setq ent2 (ssname sss (- m 1)))
                  (setq ppt3  (vlax-curve-getEndPoint ent2))
                    (Insert90 ppt1 ppt2 ppt3)
                  
                )
                (progn
                  (setq ent2 (ssname sss (+ m 1)))
                  (setq ppt3  (vlax-curve-getEndPoint ent2))
                    (Insert90 ppt1 ppt2 ppt3)
                )
              )

        ;; dont erase, for testing.      
        ;;(command "erase" ent "")       
      )
    ); repeat each edge ; repeat each line in exploded selection set--------------------------------------------------------------------------------
  ); if

(command "-purge" "la" "tempAB" "n") 
(command "._undo" "_end")
(princ)
); defun



  ;;  Convert  Radians to Degrees
  (defun rtod (r) (* 180.0 (/ r pi)))
  
  ;;figure out where the pt lies
  (defun lm:getinsideangle (p1 p2 p3)
    ((lambda (a) (min a (- (+ pi pi) a)))
      (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
    )
  )
  
   ;;D. C. Broad, Jr.
  ;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
  (defun sideof (p1 p2 p / r)
    (setq r (cond
              ((equal p1 p 1e-10) 0)
              (t (sin (- (angle p1 p) (angle p1 p2))))
            )
    )
    (if (equal r 0 1e-10) 0 r)
  ) 
  

(defun Insert90 (pt1 pt2 pt3)
 
  (setq BlkName "rebar")

  ;;return values
  ;;negative = point is to the right side of the ray
  ;;0 = point is on the ray
  ;;otherwise point is on the left side of the ray.
  ;;P1 should not equal P2 for meaningful results.
  
        (setq p1 pt1)
        (setq p2 pt2)
        (setq p3 pt3)
 
(setq lr (sideof pt1 pt2 pt3))
	(princ  lr)
	(princ "\n")
    
	 (if (> lr 0.0)
       (command "-insert" BlkName "_non" pt2 1 "" (rtod (angle pt2 pt1)))
	   )

(princ)
)
(c:abar)

image.thumb.png.7b4931880659df2472a33d97eb1f92eb.png

image.png.b5604dc946c379c3060e26eb72faa6fb.png

Version 2 having a think working out your code.

 

Edited by BIGAL
  • Like 1
Yirmeyahu Rookie

Yirmeyahu

Posted
  • Author
Posted
13 hours ago, BIGAL said:

Try this, you should not check for 90 as this is for concrete slabs a architect may have a slab with a angle. Also the bar angle should be a true 90 from the internal corner angle. See images.

  

(defun C:ABAR (/ )
 (command "._undo" "_begin")
 
   (setq sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        blk "rebar"  
    )
  (command "-layer" "m" "tempAB" "Color" "cyan" "" "Plot" "Plot" "" "Ltype" "continuous" "" "")
  
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") ) ))
    
    (repeat (setq n (sslength ss)); repeat each edge
      
      (command "_.COPY" (ssname ss (setq n (1- n))) "" "0,0" "0,0")
      (command "_.chprop" "L" "" "LA" "tempAB" "")
      (command "_.explode" "L")
      
      (setq firstRun 0)
;;-+-----repeat each line of the edge     ;;;line segment iteration------------------------------------------------------------------------------------
      (repeat (setq m (sslength (setq sss (ssget "_P"))))
            
            (setq ent (ssname sss (setq m (1- m)))
                  ppt1  (vlax-curve-getStartPoint ent) 
                  ppt2  (vlax-curve-getEndPoint ent)                
                  
            );end_setq
            
              (if (= firstRun 0)
                (progn
                  (setq firstRun 1)
                  (setq ent2 (ssname sss (- m 1)))
                  (setq ppt3  (vlax-curve-getEndPoint ent2))
                    (Insert90 ppt1 ppt2 ppt3)
                  
                )
                (progn
                  (setq ent2 (ssname sss (+ m 1)))
                  (setq ppt3  (vlax-curve-getEndPoint ent2))
                    (Insert90 ppt1 ppt2 ppt3)
                )
              )

        ;; dont erase, for testing.      
        ;;(command "erase" ent "")       
      )
    ); repeat each edge ; repeat each line in exploded selection set--------------------------------------------------------------------------------
  ); if

(command "-purge" "la" "tempAB" "n") 
(command "._undo" "_end")
(princ)
); defun



  ;;  Convert  Radians to Degrees
  (defun rtod (r) (* 180.0 (/ r pi)))
  
  ;;figure out where the pt lies
  (defun lm:getinsideangle (p1 p2 p3)
    ((lambda (a) (min a (- (+ pi pi) a)))
      (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
    )
  )
  
   ;;D. C. Broad, Jr.
  ;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
  (defun sideof (p1 p2 p / r)
    (setq r (cond
              ((equal p1 p 1e-10) 0)
              (t (sin (- (angle p1 p) (angle p1 p2))))
            )
    )
    (if (equal r 0 1e-10) 0 r)
  ) 
  

(defun Insert90 (pt1 pt2 pt3)
 
  (setq BlkName "rebar")

  ;;return values
  ;;negative = point is to the right side of the ray
  ;;0 = point is on the ray
  ;;otherwise point is on the left side of the ray.
  ;;P1 should not equal P2 for meaningful results.
  
        (setq p1 pt1)
        (setq p2 pt2)
        (setq p3 pt3)
 
(setq lr (sideof pt1 pt2 pt3))
	(princ  lr)
	(princ "\n")
    
	 (if (> lr 0.0)
       (command "-insert" BlkName "_non" pt2 1 "" (rtod (angle pt2 pt1)))
	   )

(princ)
)
(c:abar)

image.thumb.png.7b4931880659df2472a33d97eb1f92eb.png

image.png.b5604dc946c379c3060e26eb72faa6fb.png

Version 2 having a think working out your code.

 

 

Yirmeyahu Rookie

Yirmeyahu

Posted
  • Author
Posted (edited)

Perfect... but it only needs the bars at locations greater the 2'-0".  Anything less than 2'-0" does not need these bars. 

 

Thanks Bigal

Edited by Yirmeyahu
mhupp Grand Master

mhupp

Posted
Posted (edited)
4 hours ago, Yirmeyahu said:

Perfect... but it only needs the bars at locations greater the 2'-0".  Anything less than 2'-0" does not need these bars.

 

Have if statement to check dist pt1 to pt2 and pt2 to pt3 to be greater then 2'.

  

(defun Insert90 (pt1 pt2 pt3)
  ;;return values
  ;;negative = point is to the right side of the ray
  ;;0 = point is on the ray
  ;;otherwise point is on the left side of the ray.
  ;;P1 should not equal P2 for meaningful results.
  (setq p1 pt1)
  (setq p2 pt2)
  (setq p3 pt3)
  (if (and (> (distance pt1 pt2) 24) (> (distance pt2 pt3) 24)) ;inches used as unit change 24 to match your units.
    (progn
      (setq lr (sideof pt1 pt2 pt3))
      (princ lr)
      (princ "\n")
      (if (> lr 0.0)
        (command "-insert" "rebar" "_non" pt2 1 "" (rtod (angle pt2 pt1)))
      )
    )
  )
  (princ)
)
Edited by mhupp
Yirmeyahu Rookie

Yirmeyahu

Posted
  • Author
Posted

To all,

 

Thank you, I tweaked a few things and now it does exactly what I need it to do.

 

mhupp Grand Master

mhupp

Posted
Posted (edited)

Crossover from. https://www.cadtutor.net/forum/topic/74248-multiple-assoc-values/

Modified the lisp a little so it doesn't need to create layers/objects to generate the points.

 

-Edit note-

rebar block will be inserted at 0 z height if selecting 2d poly even if that poly is at a different elevation.

  

(defun C:test (/ SS pts spt pt1 pt2 pt3 )
  (vl-load-com)
  (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object))) ;this wont de-select things like (command "_undo" "begin")
  (if (setq SS (ssget "_:L" '((0 . "*POLYLINE"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq pts (cdrs 10 (entget poly))) ;generates point list
      (setq pt1 (last pts))  
      (setq spt (car pts))   ;saves starting point.
      (setq pt3 (cadr pts))
      (setvar 'cmdecho 0)
      (insert90 pt1 spt pt3)  ;checks frist verticy 
      (repeat (- (length pts) 2) 
        (setq pt1 (car pts))
        (setq pt2 (cadr pts))
        (setq pt3 (caddr pts))
        (insert90 pt1 pt2 pt3) ;checks each poly verticy
        (setq pts (cdr pts))   ;removes fist point in list
      )
      (setq pt1 (car pts))     
      (setq pt2 (cadr pts))
      (setq pt3 spt)
      (insert90 pt1 pt2 pt3)  ;checks last verticy with saved starting point and last two points in list
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (setvar 'cmdecho 1)
  (princ)
)
(defun rtod (r) (* 180.0 (/ r pi))) ;;Convert  Radians to Degrees
;;D. C. Broad, Jr.
;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
(defun sideof (p1 p2 p / r)
  (setq r
    (cond
      ((equal p1 p 1e-10) 0)
      (t (sin (- (angle p1 p) (angle p1 p2))))
    )
  )
  (if (equal r 0 1e-10) 0 r)
)
(defun insert90 (pt1 pt2 pt3)
  ;;return values
  ;;negative = point is to the right side of the ray
  ;;0 = point is on the ray
  ;;otherwise point is on the left side of the ray.
  ;;P1 should not equal P2 for meaningful results.
  (if (and (> (distance pt1 pt2) 24) (> (distance pt2 pt3) 24))
    (progn
      (setq lr (sideof pt1 pt2 pt3))
      (if (> lr 0.0) ;maybe also check to see if block rebar is in drawing
        (command "_.Insert" "rebar" "_non" pt2 1 "" (rtod (angle pt2 pt1)))
      )
    )
  )
  (princ)
)
;(cdrs 10 (entget (car (entsel "\nSelect a polyline: "))))
;returns something like this:
;((259.943 -252.219) (214.182 -140.305) (254.223 -92.925) (215.0 -21.0386) 
; (253.406 41.8621) (215.817 112.115))
;Michal Puckett
(defun cdrs (key lst / pair rtn)
  (while (setq pair (assoc key lst))
    (setq rtn (cons (cdr pair) rtn)
          lst (cdr (member pair lst))
    )
  )
  (reverse rtn)
)

 

 

Edited by mhupp

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...