[编程交流] 选择集-单独

[font=monospace](defun _GetSelPoints  (/ *error*)
 (defun *error*  (msg)
   (and oldNomutt (setvar 'nomutt oldNomutt))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (if result result (princ)))
 ((lambda (oldNomutt / startPoint endPoint result)
    (if (and (not (prompt "\nSelect objects: "))
             (setvar 'nomutt 1)
             (not (initget 1024))
             (setq startPoint (getpoint))
             (not (initget 1056))
             (setq endPoint (getcorner startPoint)))
      (progn (setq result (list startPoint endPoint)) (*error* nil))
      (*error* "Nothing selected")))
   (getvar 'nomutt)))

<li style="">([url="http://www.theswamp.org/%7Ejohn/avlisp/#defun"][color=#4D4DFF][b]defun[/b][/color][/url] _GetSelPoints  ([color=#008000]/[/color] [color=#4D4DFF][i]*error*[/i][/color])
<li style=""> 
<li style="">  ([url="http://www.theswamp.org/%7Ejohn/avlisp/#defun"][color=#4D4DFF][b]defun[/b][/color][/url] [color=#4D4DFF][i]*error*[/i][/color]  (msg)
<li style="">    ([url="http://www.theswamp.org/%7Ejohn/avlisp/#and"][color=#4D4DFF][b]and[/b][/color][/url] oldNomutt ([url="http://www.theswamp.org/%7Ejohn/avlisp/#setvar"][color=#4D4DFF][b]setvar[/b][/color][/url] 'nomutt oldNomutt))
<li style="">    ([url="http://www.theswamp.org/%7Ejohn/avlisp/#cond"][color=#4D4DFF][b]cond[/b][/color][/url] (([url="http://www.theswamp.org/%7Ejohn/avlisp/#not"][color=#4D4DFF][b]not[/b][/color][/url] msg))                                                   [color=#666666][i]; Normal exit[/i][/color]
<li style="">          (([url="http://www.theswamp.org/%7Ejohn/avlisp/#member"][color=#4D4DFF][b]member[/b][/color][/url] msg '([color=#FF0000]"Function cancelled"[/color] [color=#FF0000]"quit / exit abort"[/color])))    [color=#666666][i]; <esc> or (quit)[/i][/color]
<li style="">          (([url="http://www.theswamp.org/%7Ejohn/avlisp/#princ"][color=#4D4DFF][b]princ[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#strcat"][color=#4D4DFF][b]strcat[/b][/color][/url] [color=#FF0000]"[color=#000099][b]\n[/b][/color]** Error: "[/color] msg [color=#FF0000]" ** "[/color]))))                 [color=#666666][i]; Fatal error, display it[/i][/color]
<li style="">    ([url="http://www.theswamp.org/%7Ejohn/avlisp/#if"][color=#4D4DFF][b]if[/b][/color][/url] result result ([url="http://www.theswamp.org/%7Ejohn/avlisp/#princ"][color=#4D4DFF][b]princ[/b][/color][/url])))
<li style=""> 
<li style="">  (([url="http://www.theswamp.org/%7Ejohn/avlisp/#lambda"][color=#4D4DFF][b]lambda[/b][/color][/url] (oldNomutt [color=#008000]/[/color] startPoint endPoint result)
<li style="">     ([url="http://www.theswamp.org/%7Ejohn/avlisp/#if"][color=#4D4DFF][b]if[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#and"][color=#4D4DFF][b]and[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#not"][color=#4D4DFF][b]not[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#prompt"][color=#4D4DFF][b]prompt[/b][/color][/url] [color=#FF0000]"[color=#000099][b]\n[/b][/color]Select objects: "[/color]))
<li style="">              ([url="http://www.theswamp.org/%7Ejohn/avlisp/#setvar"][color=#4D4DFF][b]setvar[/b][/color][/url] 'nomutt [color=#0000dd]1[/color])
<li style="">              ([url="http://www.theswamp.org/%7Ejohn/avlisp/#not"][color=#4D4DFF][b]not[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#initget"][color=#4D4DFF][b]initget[/b][/color][/url] [color=#0000dd]1024[/color]))
<li style="">              ([url="http://www.theswamp.org/%7Ejohn/avlisp/#setq"][color=#4D4DFF][b]setq[/b][/color][/url] startPoint ([url="http://www.theswamp.org/%7Ejohn/avlisp/#getpoint"][color=#4D4DFF][b]getpoint[/b][/color][/url]))
<li style="">              ([url="http://www.theswamp.org/%7Ejohn/avlisp/#not"][color=#4D4DFF][b]not[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#initget"][color=#4D4DFF][b]initget[/b][/color][/url] [color=#0000dd]1056[/color]))
<li style="">              ([url="http://www.theswamp.org/%7Ejohn/avlisp/#setq"][color=#4D4DFF][b]setq[/b][/color][/url] endPoint ([url="http://www.theswamp.org/%7Ejohn/avlisp/#getcorner"][color=#4D4DFF][b]getcorner[/b][/color][/url] startPoint)))
<li style="">       ([url="http://www.theswamp.org/%7Ejohn/avlisp/#progn"][color=#4D4DFF][b]progn[/b][/color][/url] ([url="http://www.theswamp.org/%7Ejohn/avlisp/#setq"][color=#4D4DFF][b]setq[/b][/color][/url] result ([url="http://www.theswamp.org/%7Ejohn/avlisp/#list"][color=#4D4DFF][b]list[/b][/color][/url] startPoint endPoint)) ([color=#4D4DFF][i]*error*[/i][/color] [color=#4D4DFF][i]nil[/i][/color]))
<li style="">       ([color=#4D4DFF][i]*error*[/i][/color] [color=#FF0000]"Nothing selected"[/color])))
<li style="">    ([url="http://www.theswamp.org/%7Ejohn/avlisp/#getvar"][color=#4D4DFF][b]getvar[/b][/color][/url] 'nomutt)))

(defun c:sepsel ()
      (setq textsel  (ssadd)  PointSel (ssadd)
             ss       (ssget '((0 . "POINT,TEXT"))))
            (while (setq e (ssname ss 0))
  (if (eq (cdr (assoc 0 (entget e))) "POINT")
   (ssadd e PointSel)(ssadd e textsel))
                     (ssdel e ss)))

(defun c:pz (/ ldata layer punct)
 (princ "\nSELECTEAZA PUNCTELE SI TEXTELE")
 (setq ss (ssget '((0 . "POINT,TEXT"))))
 (setq i 0)
 (repeat (sslength ss)
   (setq ename (ssname ss i))
   (setq data (entget ename))
   (setq entName (cdr (assoc -1 data)))
   (setq Nume (cdr (assoc 0 data)))
   (setq ldata (cons data ldata))
   (setq i (1+ i))
 ) ;_ end of repeat
 (setq ltest ldata)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq i 0)
 (setq listat nil)
 (repeat (length ldata)
   (setq entName (cdr (assoc -1 (nth i ldata))))
   (setq Nume (cdr (assoc 0 (nth i ldata))))
   (if    (= Nume "TEXT")
     (progn
   (setq pct (cdr (assoc 10 (nth i ldata))))
   (setq z (atof (cdr (assoc 1 (nth i ldata)))))
   (setq ztext (caddr pct))
   (setq listat (cons (list pct z ztext entName) listat))
     ) ;_ end of progn
   ) ;_ end of if
   (setq i (1+ i))
 ) ;_ end of repeat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq i 0)
 (setq listap nil)
 (repeat (length ldata)
   (setq entName (cdr (assoc -1 (nth i ldata))))
   (setq Nume (cdr (assoc 0 (nth i ldata))))
   (if    (= Nume "POINT")
     (progn
   (setq punct (cdr (assoc 10 (nth i ldata))))
   (setq layer (cdr (assoc 8 (nth i ldata))))
   (setq culoare (cdr (assoc 62 (nth i ldata))))
   (setq listap (cons (list punct layer culoare entName) listap))
     ) ;_ end of progn
   ) ;_ end of if
   (setq i (1+ i))
 ) ;_ end of repeat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq listam nil)
 (setq listaep nil)
 (setq listaet nil)
 (setq i 0)
 (repeat (length listap)
   (setq text (nth i listat))
   (foreach punct listap
     (if (and (= (car (car text)) (car (car punct)))
          (= (cadr (car text)) (cadr (car punct)))
     ) ;_ end of and
   (setq p    (list
         (list
           (car (car punct))
           (cadr (car punct))
           (cadr text)
         ) ;_ end of list
         (setq la (cadr punct))
         (setq cul (caddr punct))
         (setq entitatep (cadddr punct))
         (setq entitatet (cadddr text))
         (setq pt (car text))
       ) ;_ end of list
   ) ;_ end of setq
     ) ;_ end of if
   ) ;_ end of foreach
   (setq listam (cons p listam))
   (setq listaep (cons entitatep listaep))
   (setq listaet (cons entitatet listaet))
   (setq i (1+ i))
 ) ;_ end of repeat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq i 0)
 (repeat (length listam)
   (entmake (list (cons 0 "POINT")
          (cons 8 (cadr (nth i listam)))
          (if
            (/= (caddr (nth i listam)) nil)
             (cons 62 (caddr (nth i listam)))
             (cons 62 256)
          ) ;_ end of if
          (cons 10 (car (nth i listam)))
        ) ;_ end of list
   ) ;_ end of entmake
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (command "_.move"
        (cadddr (cdr (nth i listam)))
        ""
        (setq pti (cadddr (cdr (cdr (nth i listam)))))
        (setq ptf (car (nth i listam)))
        (list
          (car (car (nth i listat)))
          (cadr (car (nth i listat)))
          (cadr (nth i listat))
        ) ;_ end of list
   ) ;_ end of command
   (setq i (1+ i))
 ) ;_ end of repeat
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setq sse (ssadd))
 (foreach ent listaep (ssadd ent sse))
 (command "erase" sse "")
 (princ)
) ;_ end of defun