Results 1 to 5 of 5

Thread: get multiple values from a subroutine

  1. #1
    Member
    Join Date
    2019-06
    Posts
    3
    Login to Give a bone
    0

    Default get multiple values from a subroutine

    Hello
    Maybe this question is so obvious, but I don't know how get multiple values from a subroutine:
    For example I have "Entities-within-a-block" subroutine and I want to get values of SubEnt , SubEntLst , SubEntLstTot
    How can I do this?
    Thanks.

    Code:
    (defun C:Blksuen ()
      (defun Entities-within-a-block (BlockSelect / SubEnt SubEntLst SubEntLstTot)
    ;;;					; get the entity list
        (setq Ent (car BlockSelect))
        (setq EntLst (entget Ent))
        (setq SubEntLstTot nil)
    ;;;					; if the entity selected was an insert
        (if	(equal "INSERT" (cdr (assoc 0 EntLst)))
          (progn
    ;;;					; get entity name from block table
    	(setq Ename (tblobjname "block" (cdr (assoc 2 EntLst))))
    ;;;					; get entity list from block table
    	(setq EntLst (entget Ename))
    ;;;					; get first subentity of the block
    	(setq SubEnt (entnext Ename))
    	(while SubEnt
    ;;;					; get sub entity list
    	  (setq SubEntLst (entget SubEnt))
    	  (setq SubEntLstTot (append SubEntLstTot (list SubEntLst)))
    ;;;					; get next subentity and repeat
    	  (setq SubEnt (entnext SubEnt))
    	)
          )
    ;;;					;else the selection was not an insert
          (princ "\selection was not a Block")
        )
      )
    ;;;					; select an entity
      (setq Entselect (entsel "\nselect border Block: "))
      (setq li nil)
      (setq li (Entities-within-a-block Entselect))
      (print li)
      (princ)
    )

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL
    Posts
    3,163
    Login to Give a bone
    0

    Default Re: get multiple values from a subroutine

    Are you trying to edit the block?
    Tom Beauford P.S.M. - Civil 2019 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

  3. #3
    Member
    Join Date
    2019-06
    Posts
    3
    Login to Give a bone
    0

    Default Re: get multiple values from a subroutine

    Quote Originally Posted by Tom Beauford View Post
    Are you trying to edit the block?
    Actually I want to get those rectangles in a specific layer whithin a block to run a lisp for multiple plotting. When I INSPECT SubEntLstTot, it workes correctly, but "li" is nil. I don't know where is my fault?

  4. #4
    All AUGI, all the time Tharwat's Avatar
    Join Date
    2010-06
    Posts
    897
    Login to Give a bone
    0

    Default Re: get multiple values from a subroutine

    Hi,
    Try this [UNTESTED] mods of your codes and let me know.
    Code:
    (defun c:Blksuen (/ sel ent ename elist lst)
      (if (and (setq sel (entsel "\nselect border Block: "))
               (setq ent (entget (car sel)))
               (equal "INSERT" (cdr (assoc 0 ent)))
          )
        (progn
          (setq Ename (tblobjname "block" (cdr (assoc 2 ent))))
          (while (setq Ename (entnext Ename))
            (if
              (and
                (= (cdr (assoc 0 (setq elist (entget Ename)))) "LWPOLYLINE")
                (= (cdr (assoc 8 elist)) "Layer1") ;; change the layer as per your desired one.
              )
             (setq lst (cons Ename lst))
            )
          )
        )
        (princ "\selection was not a Block")
      )
      (if lst
        (print lst)
      )
      (princ)
    )

  5. #5
    Member
    Join Date
    2019-06
    Posts
    3
    Login to Give a bone
    0

    Default Re: get multiple values from a subroutine

    Quote Originally Posted by Tharwat View Post
    Hi,
    Try this [UNTESTED] mods of your codes and let me know.
    Code:
    (defun c:Blksuen (/ sel ent ename elist lst)
      (if (and (setq sel (entsel "\nselect border Block: "))
               (setq ent (entget (car sel)))
               (equal "INSERT" (cdr (assoc 0 ent)))
          )
        (progn
          (setq Ename (tblobjname "block" (cdr (assoc 2 ent))))
          (while (setq Ename (entnext Ename))
            (if
              (and
                (= (cdr (assoc 0 (setq elist (entget Ename)))) "LWPOLYLINE")
                (= (cdr (assoc 8 elist)) "Layer1") ;; change the layer as per your desired one.
              )
             (setq lst (cons Ename lst))
            )
          )
        )
        (princ "\selection was not a Block")
      )
      (if lst
        (print lst)
      )
      (princ)
    )





    Thank you Tharwat. Your code workes, but just for selecting a block. I want to select multiple random blocks. So, I must use ssget and subroutine (for accessing subentities of a block).
    Let me give you my code for plotting and attach a dwg file:
    - the user may want to plot random pages
    - outer line for plot has "ol" layer
    I have problem with "IF Block" in the code below, and optimizing my code (as a matter of fact, I'm amateur in Lisp Programming.)




    Code:
    (defun c:AS-MultiPlot ()
      (setq ss nil)
      (initget "Block Pline")
      (setq	br
    	 (cond
    	   ((getkword
    	      "\n Is your Border a Block or Pline? [Block/Pline] <Pline> : "
    	    )
    	   )
    	   ("Pline")
    	 )
      )
      (initget "A4 A3")
      (setq	ps
    	 (cond
    	   ((getkword
    	      "\n What is your Paper Size for Plot? [A4/A3] <A4> : "
    	    )
    	   )
    	   ("A4")
    	 )
      )
      (initget "Portrait Landscape")
      (setq	pl
    	 (cond
    	   ((getkword
    	      "\n Is your Plot Portrait or Landscape? [Portrait/Landscape] <Landscape> : "
    	    )
    	   )
    	   ("Landscape")
    	 )
      )
      (if (= br "Pline")
    ;;;    if pline
        (progn
          (setq la (getstring "\n Specify the Layer of Outer Border: "))
          (setq ss (ssget (list (cons 0 "LWPOLYLINE") (cons 8 la))))
        )
    ;;;if block;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    
    
    
    
    
    
    
    
    
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      )
      (setq n (sslength ss))
      (setq k -1)
    ;;; Subroutin AS:Sort1
      (defun AS:Sort1 (lst)
        (vl-sort lst (function (lambda (a b) (< (car a) (car b)))))
      )
    ;;;End Subroutin AS:Sort1
    
    ;;; Subroutin AS:Sort2
      (defun AS:Sort2 (lst / newptlist)
        (setq xvals (list))
        (foreach pt	lst
          (if (not (vl-remove-if-not
    		 '(lambda (x) (equal (car (car pt)) x 0.0001))
    		 xvals
    	       )
    	  )
    	(setq xvals (cons (car (car pt)) xvals))
          )
        )
        (setq xvals (vl-sort xvals '(lambda (x1 x2) (< x1 x2))))
        (foreach xval xvals
          (setq pts	      (vl-remove-if-not
    			'(lambda (x) (equal xval (car (car x)) 0.0001))
    			lst
    		      )
    	    pts	      (vl-sort
    			pts
    			'(lambda (pt1 pt2) (> (cadr (car pt1)) (cadr (car pt2))))
    		      )
    	    newptlist (append newptlist pts)
          )
        )
      )
    ;;;End Subroutin AS:Sort2
    
      (setq lifi nil)
      (setq lici nil)
      (repeat n
        (setq lien nil)
        (setq lienso nil)
        (setq k (1+ k))
        (setq s (ssname ss k))
        (setq en (entget s))
        (foreach a en
          (if (= (car a) 10)
    	(setq lien (append lien (list (cdr a))))
          )
        )
        (setq lienso (AS:Sort1 lien))
        (cond
          ((/= (car (nth 0 lienso)) (car (nth 1 lienso)))
           (alert
    	 "Border is not a rectangular! PLOT will be done and ignore it/them."
           )
           (setq lici (append lici (list (nth 0 lienso))))
          )
          ((/= (car (nth 2 lienso)) (car (nth 3 lienso)))
           (alert
    	 "Border is not a rectangular! PLOT will be done and ignore it/them."
           )
           (setq lici (append lici (list (nth 2 lienso))))
          )
          ((/= (cadr (nth 0 lienso)) (cadr (nth 2 lienso)))
           (alert
    	 "Border is not a rectangular! PLOT will be done and ignore it/them."
           )
           (setq lici (append lici (list (nth 0 lienso))))
          )
          ((/= (cadr (nth 1 lienso)) (cadr (nth 3 lienso)))
           (alert
    	 "Border is not a rectangular! PLOT will be done and ignore it/them."
           )
           (setq lici (append lici (list (nth 1 lienso))))
          )
          (t
           (if (< (cadr (nth 0 lienso)) (cadr (nth 1 lienso)))
    	 (setq p1 (nth 0 lienso))
    	 (setq p1 (nth 1 lienso))
           )
           (if (> (cadr (nth 2 lienso)) (cadr (nth 3 lienso)))
    	 (setq p2 (nth 2 lienso))
    	 (setq p2 (nth 3 lienso))
           )
          )
        )
        (setq lifi (append lifi (list p1 p2)))
        (setq p1 nil)
        (setq p2 nil)
      )
    
      (setq lifi2 nil)
      (setq lifiso nil)
      (setq q (length lifi))
      (setq w -2)
      (repeat (/ q 2)
        (setq w (+ 2 w))
        (setq lifi2
    	   (append lifi2 (list (list (nth w lifi) (nth (1+ w) lifi))))
        )
      )
      (setq lifiso (AS:Sort2 lifi2))
      (setq nlifiso (length lifiso))
      (setq l -1)
      (repeat nlifiso
        (setq l (+ l 1))
        (setq poi1 (car (nth l lifiso)))
        (setq poi2 (cadr (nth l lifiso)))
        (command "plot"	"yes"	   "model"    "priprinter"
    	     ps		"millimeters"	      pl	 "yes"
    	     "window"	poi1	   poi2	      "fit"	 "center"
    	     "yes"	""	   "yes"      "as displayed"
    	     "no"	"yes"	   "yes"
    	    )
      )
      (foreach x lici (command "circle" x 1000.0))
      (princ)
    )
    Attached Files Attached Files

Similar Threads

  1. Replies: 0
    Last Post: 2013-02-22, 12:20 AM
  2. Replies: 1
    Last Post: 2011-12-14, 11:51 PM
  3. Replies: 4
    Last Post: 2008-11-13, 05:36 AM
  4. Level Differences (Execution project Z values minus observed Z values)
    By Ribeiro in forum AutoCAD Civil 3D - General
    Replies: 2
    Last Post: 2005-06-16, 10:40 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •