Corner Bars for Foundations

[Yirmeyahu]

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]

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

[BIGAL]

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

[Yirmeyahu]

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

 

Abar.lsp

[BIGAL]

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

 

Edited December 31, 2021 by BIGAL

[Yirmeyahu]

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

 

[BIGAL]

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)

Version 2 having a think working out your code.

 

Edited January 4, 2022 by BIGAL

[exceed]

how about to approach like this

 

make selection set of re-bars

then use SWP.lsp, it will make selection of inside of closed polyline (not visually closed, pedit > C required)

 

then substract(except) selection set 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/manipulating-splitting-a-selection-set/m-p/9649124/highlight/true#M402727

 

then delete.

[Yirmeyahu]

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)

Version 2 having a think working out your code.

 

 

[Yirmeyahu]

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 January 4, 2022 by Yirmeyahu

[mhupp]

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 January 4, 2022 by mhupp

[Yirmeyahu]

To all,

 

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

 

[mhupp]

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 January 4, 2022 by mhupp