topic Re: Lisp for reinforcement layout in Visual LISP, AutoLISP and General Customization Forum

Lisp for reinforcement layout

arvhee24 — Sun, 29 Oct 2017 11:40:03 GMT

Hi everyone,

I'm new with LISP and I really don't know how to create one but can edit (after many trials and errors).

I need a LISP making a line with the length as shown on the diagram by picking the polylines (or sometimes circle).

This is a steel reinforcement drawing so it will be having another line on Y direction but i think I can use the same LISP as X if ever.

Thanks in advance and i hope you guys can help me. 😄

Cheers!

Re: Lisp for reinforcement layout

marko_ribar — Sun, 29 Oct 2017 14:30:15 GMT

Untested...

(defun c:reinfline ( / ss i rec rpl pl cpl x2 x1 wrec len p1 p2 li )
  (prompt "\nSelect 3 rectangles...")
  (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>") (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>"))))
  (while (or (not ss) (and ss (/= (sslength ss) 3)))
    (prompt "\nEmpty sel. set... Please reselect 3 rectangles again...")
    (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>") (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>"))))
  )
  (repeat (setq i 3)
    (setq rec (ssname ss (setq i (1- i))))
    (setq rpl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget rec))))
    (setq pl (cons rpl pl))
  )
  (setq cpl (mapcar '(lambda ( x ) (mapcar '/ (apply 'mapcar (cons '+ x)) (list 4.0 4.0 4.0))) pl))
  (setq cpl (vl-sort cpl '(lambda ( a b ) (< (car a) (car b)))))
  (setq x2 (distance (car cpl) (cadr cpl)) x1 (distance (cadr cpl) (caddr cpl)))
  (setq wrec (- (car (apply 'mapcar (cons 'max (car pl)))) (car (apply 'mapcar (cons 'min (car pl))))))
  (setq len (+ (/ x2 5.0) wrec (/ x1 5.0)))
  (setq p1 (polar (cadr cpl) pi (+ (/ x2 5.0) (/ wrec 2.0))))
  (setq p2 (polar p1 0.0 len))
  (setq li (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))))
  (vl-cmdf "_.MOVE" li "" "_non" (cadr cpl))
  (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\"))
  (princ)
)

Re: Lisp for reinforcement layout

marko_ribar — Sun, 29 Oct 2017 14:49:22 GMT

Replace this line :

(setq x2 (distance (car cpl) (cadr cpl)) x1 (distance (cadr cpl) (caddr cpl)))

With this mod... :

(setq x2 (distance (car cpl) (list (caadr cpl) (cadar cpl))) x1 (distance (cadr cpl) (list (caaddr cpl) (cadadr cpl))))

Re: Lisp for reinforcement layout

marko_ribar — Sun, 29 Oct 2017 15:12:05 GMT

One more mod...

Replace :

(setq wrec (- (car (apply 'mapcar (cons 'max (car pl)))) (car (apply 'mapcar (cons 'min (car pl))))))

With these two lines :

(setq pl (vl-sort pl '(lambda ( a b ) (< (distance (cadr cpl) (mapcar '/ (apply 'mapcar (cons '+ a)) (list 4.0 4.0 4.0))) (distance (cadr cpl) (mapcar '/ (apply 'mapcar (cons '+ b)) (list 4.0 4.0 4.0)))))))
(setq wrec (- (car (apply 'mapcar (cons 'max (car pl)))) (car (apply 'mapcar (cons 'min (car pl))))))

Re: Lisp for reinforcement layout

joselggalan — Sun, 29 Oct 2017 18:53:51 GMT

Try this:

(vl-load-com)
;;============================= c:Test0007 ====================================;;
;; Jose L. García G. -  29/10/17                                               ;;
;;=============================================================================;;
(defun c:Test0007 (/ ss lstSs LstDatCurves Obj1 Obj2 Obj3 D1 D2 Box2
		     Long2 X2 p1L p2L BoxAll PtMidAll
		     ;|Functions|; Aux-GetBoxObj MidPt)
 
	(defun Aux-GetBoxObj (obj / MinPt MaxPt v1 v3  Retval)
	 (cond
	  ((vlax-method-applicable-p obj 'getboundingbox)
	   (vla-getboundingbox obj 'MinPt 'MaxPt)
	   (list (vlax-safearray->list MinPt)
		 (vlax-safearray->list MaxPt))
	  )
	 );c.cond
	);c.defun
 
	(defun MidPt (a b)
	 (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) a b)
	)
 ;;--------------------- MAIN -----------------
 (cond
  ((not (setq ss (ssget (list '(0 . "LWPOLYLINE,CIRCLE")))))
   (prompt "\n¡Nothing Selected.!")
  )
  ((/= (sslength ss) 3)
   (prompt "\n¡You can only select 3 objects.!")	
  )
  (T
   (setq lstSs (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (mapcar
    (function
     (lambda (eCurve / oCurve Box)
      (setq oCurve (vlax-ename->vla-object eCurve))
      (cond
       ((setq Box (Aux-GetBoxObj oCurve))
	(setq Tmp (list (apply 'MidPt Box) ;;Center Curve
			Box))
	(setq LstDatCurves (cons Tmp LstDatCurves))
       )
      );c.cond
     )
    )
    lstSs
   );c.mapcar
   (cond
    (LstDatCurves
     (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
     (setq BoxAll
	   (mapcar
	    (function
	     (lambda ( a b )
	      (apply 'mapcar (cons a b))
	     )
	    )
	    '(min max)
	    (list (mapcar 'caadr  LstDatCurves)
		  (mapcar 'cadadr  LstDatCurves))
	   )
     )
     (setq PtMidAll (apply 'MidPt BoxAll)) 
     ;;(command "_point" PtMidAll)
     (setq LstDatCurves
      (vl-sort
       LstDatCurves (function (lambda (e1 e2) (< (caar e1) (caar e2)))))
     ) 
     (setq Obj1 (car LstDatCurves)
	   Obj2 (cadr LstDatCurves)
	   Obj3 (last LstDatCurves))
     (setq D2 (- (caar Obj2)(caar Obj1))
	   D1 (- (caar Obj3)(caar Obj2)))
     (setq Box2 (cadr Obj2)
	   Long2 (abs (car (apply 'mapcar (cons '- Box2))))
	   X2 (caar Box2))
     (setq p1L (list (- X2 (/ D2 5.0)) (cadr PtMidAll))
	   p2L (list (+ X2 Long2 (/ D1 5.0)) (cadr PtMidAll)))
     (entmakex (list '(0 . "LINE")(cons 10 p1L)(cons 11 p2L) '(62 . 4)))
     (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
   )
  )
 );c.cond
 (princ)
)

regards..

Re: Lisp for reinforcement layout

Kent1Cooper — Sun, 29 Oct 2017 19:30:54 GMT

@marko_ribar wrote:

....

....
  (prompt "\nSelect 3 rectangles...")
  (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>") (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>"))))
  (while (or (not ss) (and ss (/= (sslength ss) 3)))
    (prompt "\nEmpty sel. set... Please reselect 3 rectangles again...")
    (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>") (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>"))))
....

Not really relevant to the operational part of the question, but just some suggestions about the selection....

There's a slightly simpler way to filter for closed Polylines whether or not linetype generation is enabled in them, than checking for whether the (assoc 70) value is either 1 or 129 -- the one below checks simply for whether it contains the 1 bit, and whether or not it also contains the 128 bit doesn't matter.

The (42 . 0) filter item would be satisfied with only one no-bulge [line] segment, and so would accept selection of many non-rectangular Polylines. I don't think you can filter for whether all bulge factors are zero, but if it's important [i.e. you can't assume the User is going to select only the right kinds of things], you could check the selected ones for that after selection. You could also check for whether they're actually rectangular [I have code to do that if you're interested], and whether they're aligned in the same direction, with more code, but again, not in the (ssget) filtering.

I would also check for four vertices.

And rather than spell out the entire (setq) line with (ssget) filter twice, I would re-arrange things a little to do it only once.

....
  (prompt "\nSelect 3 closed rectangular Polylines: ")
  (while
    (not
      (and
        (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
        (= (sslength ss) 3)
      ); and
    ); not
    (prompt "\nIncorrect - try again...")
  ); while
....

[By the way, the original's scolding is incorrect in that an empty selection set is not the only reason it would appear.]

Re: Lisp for reinforcement layout

marko_ribar — Sun, 29 Oct 2017 20:51:14 GMT

Correct, I forgot about (90 . 4) and just copy+pasted that line without that important filter dotted pair... OP can just add it in both places... You are also right that it could be written shortly, but for me it's only copy+paste thing and I used to construct that starting input sentences that way... Still without (42 . 0.0) check user could select those that have bulges and I wanted to avoid that thing, and I know that there is perhaps better way to check for exact rectangle shape, but I suppose OP/user is not so blind not to understand the meaning of complete filter and I assume that according to provided picture only valid attempts would be initiated by user as he/she is knowing what is needed for the task that was requested... Anyway your observation is very welcome and can only benefit to make solution even more perfect...

Re: Lisp for reinforcement layout

joselggalan — Sun, 29 Oct 2017 23:41:26 GMT

@arvhee24 wrote:

.... by picking the polylines (or sometimes circle).

It is assumed. But it is not indicated that polylines are necessarily rectangles.

Re: Lisp for reinforcement layout

arvhee24 — Mon, 30 Oct 2017 04:43:12 GMT

Thanks guys, this helps a lot...

Really appreciate your efforts.

Cheers!

Re: Lisp for reinforcement layout

arvhee24 — Mon, 30 Oct 2017 04:46:25 GMT

Thanks Mr. Jose.

I can use this lisp for my work and it really helps.

Only thing is if I change my UCS, the line created is still at world.

But I guess i can just rotate the part if I need to.

Really appreciate your help.

Cheers! 🙂

Re: Lisp for reinforcement layout

marko_ribar — Mon, 30 Oct 2017 05:37:57 GMT

Here, for various UCS in 3D...

(vl-load-com)
;;============================= c:Test0008 ========================================;;
;; Jose L. García G. - 29-30/10/17 - Mod. by Marko M. Ribar - applicable in 3D UCS ;;
;;=================================================================================;;
(defun c:Test0008 ( / ss lstSs LstDatCurves Obj1 Obj2 Obj3 D1 D2 Box2
		     Long2 X2 p1L p2L BoxAll PtMidAll mat lin
		     ;|Functions|; Aux-GetBoxObj MidPt )
 
	(defun Aux-GetBoxObj ( obj / MinPt MaxPt v1 v3  Retval )
	 (cond
	  ((vlax-method-applicable-p obj 'getboundingbox)
	   (vla-getboundingbox obj 'MinPt 'MaxPt)
	   (list (vlax-safearray->list MinPt)
		        (vlax-safearray->list MaxPt))
	  )
	 );c.cond
	);c.defun
 
	(defun MidPt ( a b )
	 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
	)
 ;;--------------------- MAIN -----------------
 (setq mat
  (list
   (list (car (getvar 'ucsxdir)) (car (getvar 'ucsydir)) (car (trans '(0.0 0.0 1.0) 1 0 t)) (car (getvar 'ucsorg)))
   (list (cadr (getvar 'ucsxdir)) (cadr (getvar 'ucsydir)) (cadr (trans '(0.0 0.0 1.0) 1 0 t)) (cadr (getvar 'ucsorg)))
   (list (caddr (getvar 'ucsxdir)) (caddr (getvar 'ucsydir)) (caddr (trans '(0.0 0.0 1.0) 1 0 t)) (caddr (getvar 'ucsorg)))
   (list 0.0 0.0 0.0 1.0)
  )
 )
 (cond
  ((not (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,CIRCLE")))))
   (prompt "\nNothing Selected.!")
  )
  ((/= (sslength ss) 3)
   (prompt "\nYou can only select 3 objects.!")	
  )
  (T
   (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
   (setq lstSs (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (mapcar
    (function
     (lambda ( eCurve / oCurve Box )
      (setq oCurve (vlax-ename->vla-object eCurve))
      (cond
       ((setq Box (Aux-GetBoxObj oCurve))
        (setq Tmp (list (apply 'MidPt Box) ;;Center Curve
                        Box))
        (setq LstDatCurves (cons Tmp LstDatCurves))
       )
      );c.cond
     )
    )
    lstSs
   );c.mapcar
   (cond
    (LstDatCurves
     (setq BoxAll
           (mapcar
            (function
             (lambda ( a b )
              (apply 'mapcar (cons a b))
             )
            )
            '(min max)
            (list (mapcar 'caadr  LstDatCurves)
                  (mapcar 'cadadr  LstDatCurves))
           )
     )
     (setq PtMidAll (apply 'MidPt BoxAll)) 
     ;;(command "_point" PtMidAll)
     (setq LstDatCurves
      (vl-sort
       LstDatCurves (function (lambda ( e1 e2 ) (< (caar e1) (caar e2)))))
     ) 
     (setq Obj1 (car LstDatCurves)
           Obj2 (cadr LstDatCurves)
           Obj3 (last LstDatCurves))
     (setq D2 (- (caar Obj2)(caar Obj1))
           D1 (- (caar Obj3)(caar Obj2)))
     (setq Box2 (cadr Obj2)
           Long2 (abs (car (apply 'mapcar (cons '- Box2))))
           X2 (caar Box2))
     (setq p1L (list (- X2 (/ D2 5.0)) (cadr PtMidAll))
           p2L (list (+ X2 Long2 (/ D1 5.0)) (cadr PtMidAll)))
     (setq lin (entmakex (list '(0 . "LINE")(cons 10 p1L)(cons 11 p2L) '(62 . 4))))
     (vla-transformby (vlax-ename->vla-object lin) (vlax-tmatrix mat))
    )
   )
   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
 );c.cond
 (princ)
)

Regards., M.R.

Re: Lisp for reinforcement layout

arvhee24 — Mon, 30 Oct 2017 06:02:20 GMT

Thanks Mr. Marko.

I've tried your routine with the mods and the correction from Mr. Kent and it works well too, but the only thing is i can't use it with circle.

And is there any chance it can work on Y-axis?

Cheers!

Re: Lisp for reinforcement layout

marko_ribar — Mon, 30 Oct 2017 06:08:50 GMT

Disregard previous posted code... I was in a hurry... This one is fine for various UCS... So for Y axis, you rotate your UCS 90 degree CCW and apply this mod...

(vl-load-com)
;;============================= c:Test0008 ========================================;;
;; Jose L. García G. - 29-30/10/17 - Mod. by Marko M. Ribar - applicable in 3D UCS ;;
;;=================================================================================;;
(defun c:Test0008 ( / ss lstSs LstDatCurves Obj1 Obj2 Obj3 D1 D2 Box2
		     Long2 X2 p1L p2L BoxAll PtMidAll matucs matwcs lin
		     ;|Functions|; Aux-GetBoxObj MidPt )
 
	(defun Aux-GetBoxObj ( obj / MinPt MaxPt v1 v3  Retval )
	 (cond
	  ((vlax-method-applicable-p obj 'getboundingbox)
	   (vla-getboundingbox obj 'MinPt 'MaxPt)
	   (list (vlax-safearray->list MinPt)
		        (vlax-safearray->list MaxPt))
	  )
	 );c.cond
	);c.defun
 
	(defun MidPt ( a b )
	 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
	)
 ;;--------------------- MAIN -----------------
 (setq matucs
  (list
   (list (car (getvar 'ucsxdir)) (car (getvar 'ucsydir)) (car (trans '(0.0 0.0 1.0) 1 0 t)) (car (getvar 'ucsorg)))
   (list (cadr (getvar 'ucsxdir)) (cadr (getvar 'ucsydir)) (cadr (trans '(0.0 0.0 1.0) 1 0 t)) (cadr (getvar 'ucsorg)))
   (list (caddr (getvar 'ucsxdir)) (caddr (getvar 'ucsydir)) (caddr (trans '(0.0 0.0 1.0) 1 0 t)) (caddr (getvar 'ucsorg)))
   (list 0.0 0.0 0.0 1.0)
  )
 )
 (setq matwcs
  (list
   (list (car (trans '(1.0 0.0 0.0) 0 1 t)) (car (trans '(0.0 1.0 0.0) 0 1 t)) (car (trans '(0.0 0.0 1.0) 0 1 t)) (car (trans '(0.0 0.0 0.0) 0 1)))
   (list (cadr (trans '(1.0 0.0 0.0) 0 1 t)) (cadr (trans '(0.0 1.0 0.0) 0 1 t)) (cadr (trans '(0.0 0.0 1.0) 0 1 t)) (cadr (trans '(0.0 0.0 0.0) 0 1)))
   (list (caddr (trans '(1.0 0.0 0.0) 0 1 t)) (caddr (trans '(0.0 1.0 0.0) 0 1 t)) (caddr (trans '(0.0 0.0 1.0) 0 1 t)) (caddr (trans '(0.0 0.0 0.0) 0 1)))
   (list 0.0 0.0 0.0 1.0)
  )
 )
 (cond
  ((not (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,CIRCLE")))))
   (prompt "\nNothing Selected.!")
  )
  ((/= (sslength ss) 3)
   (prompt "\nYou can only select 3 objects.!")	
  )
  (T
   (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
   (setq lstSs (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (foreach e lstSs
    (vla-transformby (vlax-ename->vla-object e) (vlax-tmatrix matwcs))
   )
   (mapcar
    (function
     (lambda ( eCurve / oCurve Box )
      (setq oCurve (vlax-ename->vla-object eCurve))
      (cond
       ((setq Box (Aux-GetBoxObj oCurve))
        (setq Tmp (list (apply 'MidPt Box) ;;Center Curve
                        Box))
        (setq LstDatCurves (cons Tmp LstDatCurves))
       )
      );c.cond
     )
    )
    lstSs
   );c.mapcar
   (cond
    (LstDatCurves
     (setq BoxAll
           (mapcar
            (function
             (lambda ( a b )
              (apply 'mapcar (cons a b))
             )
            )
            '(min max)
            (list (mapcar 'caadr  LstDatCurves)
                  (mapcar 'cadadr  LstDatCurves))
           )
     )
     (setq PtMidAll (apply 'MidPt BoxAll)) 
     ;;(command "_point" PtMidAll)
     (setq LstDatCurves
      (vl-sort
       LstDatCurves (function (lambda ( e1 e2 ) (< (caar e1) (caar e2)))))
     ) 
     (setq Obj1 (car LstDatCurves)
           Obj2 (cadr LstDatCurves)
           Obj3 (last LstDatCurves))
     (setq D2 (- (caar Obj2)(caar Obj1))
           D1 (- (caar Obj3)(caar Obj2)))
     (setq Box2 (cadr Obj2)
           Long2 (abs (car (apply 'mapcar (cons '- Box2))))
           X2 (caar Box2))
     (setq p1L (list (- X2 (/ D2 5.0)) (cadr PtMidAll))
           p2L (list (+ X2 Long2 (/ D1 5.0)) (cadr PtMidAll)))
     (setq lin (entmakex (list '(0 . "LINE")(cons 10 p1L)(cons 11 p2L) '(62 . 4))))
     (foreach e lstSs
      (vla-transformby (vlax-ename->vla-object e) (vlax-tmatrix matucs))
     )
     (vla-transformby (vlax-ename->vla-object lin) (vlax-tmatrix matucs))
    )
   )
   (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
 );c.cond
 (princ)
)

M.R.

Re: Lisp for reinforcement layout

arvhee24 — Mon, 30 Oct 2017 06:30:25 GMT

Oh wow!

This works like a charm.

This is definitely it!

Thanks so much Mr. Marko 🙂

And to all of you guys who help on this routine Mr. Jose and Mr. Kent...

Your efforts and time are most appreciated.

Cheers!

Re: Lisp for reinforcement layout

abdulellah.alattab — Sun, 01 Nov 2020 01:53:25 GMT

some thing wrrong , why , center box width add to result line length at each side