How to apply Lisp routine to multiple selection of points.

How to apply Lisp routine to multiple selection of points.

dlbsurveysuk
Collaborator Collaborator
590 Views
3 Replies
Message 1 of 4

How to apply Lisp routine to multiple selection of points.

dlbsurveysuk
Collaborator
Collaborator

Hi,

 

I have a simple lisp routine (see below) that allows me to select a node and then inserts a cross and level text at that point.

 

What I would like is to be able to select multiple nodes (eg crossing box) and then insert the cross and level text (based on the Z value of each individual node) to each node in one go.

 

Any help appreciated.

Thanks.

 

 

(defun C:LP (/ pt tat Y olderr)
   (setq olderr  *error*             ; Initialize variables
         *error* cterr )


 (setvar "cmdecho" 0)
 (setq OSM (getvar "OSMODE"))
 (setq lll (getvar "CLAYER"))
 (setq a(getvar "textsize"))


   (command "osnap" "NODE")
   (setq pt(getpoint "Whereabouts...?"))
   (command "osnap" "NONE")


       (setq X (car PT))
       (setq Y (cadr pt))
       (setq Z (rtos (caddr PT) 2 2))
       (setq XYPT(list (car PT)(cadr PT)))
       (setq Tat (LIST X (- Y (* 2 a))))


   (command "layer" "M" "LX" "")
   (command "insert" "CROSS" XYpt a "" 0.0)
   (command "layer" "M" "LTEXT" "")
   (command "text" Tat "" 0.0 Z)


 (setvar "OSMODE" OSM)
 (command "LAYER" "S" lll "")
 (setq *error* olderr)             ; Restore old *error* handler
 (princ)
 (setvar "CLAYER" "construction")
)

 

0 Likes
Accepted solutions (1)
591 Views
3 Replies
Replies (3)
Message 2 of 4

ВeekeeCZ
Consultant
Consultant
Accepted solution

Untested

 

(defun C:LP (/ s i pt pt tat Y olderr)
  (setq olderr  *error*             ; Initialize variables
	*error* cterr )
  
  (setvar "cmdecho" 0)
  (setq OSM (getvar "OSMODE"))
  (setq lll (getvar "CLAYER"))
  (setq a(getvar "textsize"))
  
  (if (setq s (ssget '((0 . "POINT"))))
    (repeat (setq i (sslength s))
      (setq pt (trans (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) 0 1))
            
      (setq X (car PT))
      (setq Y (cadr pt))
      (setq Z (rtos (caddr PT) 2 2))
      (setq XYPT(list (car PT)(cadr PT)))
      (setq Tat (LIST X (- Y (* 2 a))))
      
      
      (command "layer" "M" "LX" "")
      (command "insert" "CROSS" XYpt a "" 0.0)
      (command "layer" "M" "LTEXT" "")
      (command "text" Tat "" 0.0 Z)
      ))
  
  (setvar "OSMODE" OSM)
  (command "LAYER" "S" lll "")
  (setq *error* olderr)             ; Restore old *error* handler
  (princ)
  (setvar "CLAYER" "construction")
  )

 

0 Likes
Message 3 of 4

dlbsurveysuk
Collaborator
Collaborator

That was quick!

 

Thank you. tested and seems to work fine.

 

Looking at the code I can see (even with my rudimentary lisp experience) roughly what is going on.

 

Thanks again. That should save me some time in certain situations.

0 Likes
Message 4 of 4

Sea-Haven
Mentor
Mentor

Maybe a couple of suggestions 

Only need layer "M" once at start then use (setvar 'clayer xxxx) a better way is (tblsearch "layers" "LX") it will return T if exists. If not then make it.

 

(command "layer" "M" "LX" "") ; check does exist

(setvar 'clayer "LX")
(command "insert" "CROSS" XYpt a "" 0.0)
(setvar 'clayer "LXTEXT")


(setq lll (getvar "CLAYER")) ; used at start

(setvar 'clayer lll) ; used at end