Creating List of newly made points and using that in next function

Anonymous · ‎07-21-2016

I have this code, which creates text and inserts a block on a selection of 3D points which are created from the first function from Attributed Blocks. I want to narrow it down to one step instead of having to select the points twice.

Is it possible to create a new list at the end of the first function which contains all the newly created 3D points and instead of having to select them again, use that set for the next two functions which are narrowed down to just one step?

(defun c:toelev1( / opt lay count object elev)                                     ;;program name is toelev
   (setq ssPoints (ssget '((0 . "INSERT")(2 . "POINT"))))                         ;;restrict selection set
   (initget "Yes No")                                                             ;;initialize keywords
   (setq opt (getkword "\nWould you like to add AutoCAD point to the drawing?"))  ;;find out if adding nodes
   (if (= opt "Yes")                                                              ;;selected yes?
      (while (= lay nil)                                                          ;;prompt for layer name until
         (setq lay "SPOTHEIGHT_POINTS")         				  ;;user enters one
      )                                                                           ;;while
   )                                                                              ;;if
   (setq count 0)                                                                 ;;initialize counter
   (repeat (sslength ssPoints)                                                    ;;repeat for each point
      (setq object (entget (entnext (ssname ssPoints count))))                    ;;get entity data
      (if (= "ELEV" (cdr (assoc 2 object)))                                       ;;check if first attribute
         (progn                                                                   ;;is elevation
            (setq elev (atof (cdr (assoc 1 object))))                             ;;get elevation attribute
            (moveup (ssname ssPoints count) elev opt lay)                         ;;run move up function
            (setq count (+ count 1))                                              ;;increment counter
         )                                                                        ;;progn
      )                                                                           ;;if
   )                                                                              ;;repeat
   (princ)
)                                                                                 ;;defun
(defun moveup(pntblock elev opt lay / )                                           ;;moveup function takes
    (setq pntblock (entget pntblock))                                             ;;pntblock & elev parameters
    (setq pntblock (subst (list 10 (cadr (assoc 10 pntblock))                     ;;substitute new elev for old
                                   (caddr (assoc 10 pntblock)) 
                                    elev) (assoc 10 pntblock) 
                    pntblock))
    (entmod pntblock)                                                             ;;update point block
    (if (= opt "Yes")                                                             ;;if user chose yes earlier
       (entmake (list '(0 . "POINT") (assoc 10 pntblock) (cons 8 lay)))           ;;make an AutoCAD point
    )                                                                             ;;if
    (princ)
)
;;;;;;;;;;;;;;;;
(defun SPOT ( / pt ent loc pt2 elv i sty)
  (prompt "\nSelect points: ")
  (setq sset (ssget '((0 . "POINT")))
	i 0
	z (getvar "textsize")
  )
  (setq sty "R")
  (if (not (tblsearch "STYLE" sty))
   (setq sty (getvar 'textstyle))
  )
  (if sset
    (repeat (sslength sset)
      (setq pt (ssname sset i))
      (setq ent (entget pt))
      (setq loc (cdr (assoc 10 ent)))
      (setq pt2 (polar (list (car loc) (cadr loc)) 0.0 z))
      (setq elv (last loc))
      (entmake (list
	        (cons 0 "TEXT")
		(cons 100 "AcDbText")
	        (cons 8 "SPOTLEVELS")		;Layer
		(cons 1 (rtos elv 2 2))		;Content
	        (cons 10 pt2)			;Insert Point
	        (cons 40 0.4)			;Text Height
		(cons 41 0.8)			;Text Width
	        (cons 71 1)			;Justification (4=Top Left)
		(cons 50 0.785398)		;Rotation (Radians)
		(cons 51 0.261799)		;Oblique Angle
		(cons 7 sty)			;Text Style
	       )
      )
      (setq i (1+ i))
    )
    (princ "\n No POINT objects found!   ")
  )  
  (princ)
)
;;;;;;;;;;;;;;;;
(defun cross ( / BlockName sn)
  (setq BlockNAme "SH_CROSS") 
  (if (not (tblsearch "BLOCK" BlockName))
    (prompt (strcat "\nBlock name <" BlockName "> is not found in this drawing !"))
    (while (setq sn (ssname sset 0))
      (entmake (list '(0 . "INSERT") (cons 2 BlockName) (assoc 10 (entget sn))))
      (ssdel sn sset)
    )
  )
  (princ)
)
 (defun c:WSH( / sset )
 	(c:toelev1)
 	(SPOT)
 	(if sset (cross))
	(command "-layer" "off" "SPOTHEIGHT_POINTS")
 (princ)
)

pbejse · ‎07-21-2016

You can use the newly created poijnts from to ELEV1 routine as arguments for SPOT instead of a 3D pointlist, That way it wouldn't affect the code as much, Will that work for you?

pbejse · ‎07-21-2016

@pbejse wrote:

You can use the newly created points from to ELEV1 routine as arguments for SPOT instead of a 3D pointlist, That way it wouldn't affect the code as much, Will that work for you?

I just realized that is exactly what you mean on your first post. as POINT entities and not point lists

   (setq npoints (ssadd)
	  ssPoints (ssget '((0 . "INSERT")(2 . "POINT"))))

  ....
 )                                                                              ;;repeat
  (sssetfirst nil npoints)
  (princ)
)

   	......
 	(if sset (cross))
   	(sssetfirst nil)
	(command "-layer" "off" "SPOTHEIGHT_POINTS")

HTH

Shneuph · ‎07-22-2016

From what I can understand the op wants to do something like this? (untested)

(defun c:toelev1( / opt lay count object elev)
   (setq ssPoints (ssget '((0 . "INSERT"))))
   (initget "Yes No")
   (setq opt (getkword "\nWould you like to add AutoCAD point to the drawing?"))  ;;find out if adding nodes
   (if (= opt "Yes")
     (progn
       (setq ssnewpoints (ssadd))
       (while (= lay nil)
	 (setq lay "SPOTHEIGHT_POINTS")
	 )
       );prong
     );if
  (setq count 0)
  (repeat (sslength ssPoints)
    (setq object (entget (entnext (ssname ssPoints count))))
    (if (= "ELEV" (cdr (assoc 2 object)))
      (progn
	(setq elev (atof (cdr (assoc 1 object))))
	(moveup (ssname ssPoints count) elev opt lay)
	(setq count (+ count 1))
	)
      )
    )
  (princ)
  )

(defun moveup(pntblock elev opt lay / )
  (setq pntblock (entget pntblock))
  (setq pntblock (subst (list 10 (cadr (assoc 10 pntblock))
			      (caddr (assoc 10 pntblock))
			      elev) (assoc 10 pntblock)
			pntblock))
  (entmod pntblock)
  (if (= opt "Yes")
    (ssadd ssnewpoints (entmake (list '(0 . "POINT") (assoc 10 pntblock) (cons 8 lay))) ssnewpoints);;make an AutoCAD point
    )
  (princ)
  )


(Defun SPOT ( / pt ent loc pt2 elv i sty)
  
  (setq sset ssnewpoints
	i 0
	z (getvar "textsize")	  )
  (setq sty "R")
  (if (not (tblsearch "STYLE" sty))
    (setq sty (getvar 'textstyle))
    )
  (if sset
    (repeat (sslength sset)
      (setq pt (ssname sset i))
      (setq ent (entget pt))
      (setq loc (cdr (assoc 10 ent)))
      (setq pt2 (polar (list (car loc) (cadr loc)) 0.0 z))
      (setq elv (last loc))
      (entmake (list
		 (cons 0 "TEXT")
		 (cons 100 "AcDbText")
		 (cons 8 "SPOTLEVELS")
		 (cons 1 (rtos elv 2 2))
		 (cons 10 pt2)
		 (cons 40 0.4)
		 (cons 41 0.8)
		 (cons 71 1)
		 (cons 50 0.785398)
		 (cons 51 0.261799)
		 (cons 7 sty)
		 )
	       )
      (setq i (1+ i))
      )
    (princ "\n No POINT objects found!   ")
    )
  (princ)
  )

;;;;;;;;;;;;;;;;
(defun cross ( / BlockName sn)
  (setq BlockNAme "SH_CROSS")
  (if (not (tblsearch "BLOCK" BlockName))
    (prompt (strcat "\nBlock name <" BlockName "> is not found in this drawing !"))
    (while (setq sn (ssname sset 0))
      (entmake (list '(0 . "INSERT") (cons 2 BlockName) (assoc 10 (entget sn))))
      (ssdel sn sset)
      )
    )
  (princ)
  )


(Defun c:WSH( / sset )
  (c:toelev1)
  (SPOT)
  (if sset (cross))
  (command "-layer" "off" "SPOTHEIGHT_POINTS")
  (princ)
  )

---sig---------------------------------------
'(83 104 110 101 117 112 104 64 71 109 97 105 108 46 99 111 109)

pbejse · ‎07-22-2016

@Shneuph wrote:

From what I can understand the op wants to do something like this? (untested) )

😄 Thought i already had this part earlier on my post

(ssadd  (entmake (list '(0 . "POINT") (assoc 10 pntblock) (cons 8 lay))) npoints)

Apparently i didn't . FWIW what Shneuph posted is exactly what i meant to.

Good catch

Cheers

Community

Creating List of newly made points and using that in next function

Creating List of newly made points and using that in next function

Creating List of newly made points and using that in next function