[编程交流] ssget-再次

      (setq ss (ssget '(
            (-4 . "<OR")
            (-4 . "<AND")
            ("_CP"  lst)
            (0 . "POINT")
            (-4 . "AND>")
            (-4 . "OR>"))))

(setq ss (ssget "_CP" lst '((0 . "POINT"))))

(defun c:Z3( /   te sizetext oldEcho oldosmode
       p1 p2 p3 linie ppt z )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendBoth) 3)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)       
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (vl-load-com)
   (defun *error* (msg) 
   (and uFlag (vla-EndUndoMark aDoc)) 
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
                (princ (strcat "\n** Error: " msg " **")))) 
   (princ)) 
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))) 
(setq uFlag (not (vla-StartUndoMark aDoc)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setvar "dimdec" 3)
 (princ "\nSELECTEAZA TEXT PENTRU MARIME CARACTERE")
 (if(setq te (entsel))
 (setq sizetext (cdr(assoc 40 (entget(car te))))))
 (if (=  te nil)(setq sizetext 5))
 (setq oldEcho(getvar "CMDECHO")) 
 (setvar "CMDECHO" 0)
 (setq oldosmode (getvar "OSMODE"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (setvar "OSMODE" 512)
 (princ "\nSELECTEAZA PUNCT")
  (if 
     (setq p1 (getpoint "\nPOINT  1")
       p2 (getpoint "\nPOINT 2")
       p3 (getpoint "\nPOINT 3")
       pc (getpoint "\nPOINT UNKNOWN"))    
   (progn
      (setvar "OSMODE" 9)
      (SETVAR "CECOLOR" "232")
      (command "_.line" p1 p2 "")
      (setq l12 (entlast))
      (command "_.line" p1 p3 "")
      (setq l13 (entlast))
      (command "_.line" p2 p3 "")
      (setq l23 (entlast))
      (command "_.line" p1 pc "")
      (setq lc (entlast))
      (setq x1 (car p1)
        x2 (car p2)
        x3 (car p3)
        xc (car pc)
        y1 (cadr p1)
        y2 (cadr p2)
        y3 (cadr p3)
        yc (cadr pc)
        z1 (caddr p1)
        z2 (caddr p2)
        z3 (caddr p3)     
   )
     (command "_.line" (list x2 y2 0) (list x3 y3 0) "")
     (setq l23p (entlast))
     (command "_.line" (list x1 y1 0) (list xc yc 0) "")
     (setq lp (entlast))
     (setq pint0 (LM:GetIntersections (vlax-ename->vla-object l23p) (vlax-ename->vla-object lp)))
     (setq pint0 (list (caar pint0) (cadr (car pint0)) (caddr (car pint0))))
     (command "_.line" pint0  (list (car pint0) (cadr pint0) 10.0) "")
     (setq lint (entlast))
     (setq pint (LM:GetIntersections (vlax-ename->vla-object lint) (vlax-ename->vla-object l23)))
     (setq pint (list (caar pint) (cadr (car pint)) (caddr (car pint))))
     (command "_.line" p1 pint "")
     (setq lcf (entlast))
     (command "_.line" pc (list (car pc) (cadr pc) 10.0) "")
     (setq laj (entlast))
     (setq pcf (LM:GetIntersections (vlax-ename->vla-object laj) (vlax-ename->vla-object lcf)))
     (setq pcf (list (caar pcf) (cadr (car pcf)) (caddr (car pcf))))
     (setq z (rtos (caddr pcf) 2 3))
     (command "_.point" pcf)
     (command "text"  pcf  sizetext "0" (strcat "  " z))
     (command "_.erase" l12 l13 l23 lc l23p lp lint lcf laj "")
     (SETVAR "CECOLOR" "BYLAYER")
    ); end progn
  );end if
      (setvar "CMDECHO" oldEcho)
      (setvar "OSMODE" OLDOSMODE)
      (setvar "dimdec" 2)  
 (*error* nil) 
 (princ)
)

;; Line-Plane Intersection  -  Lee Mac
;; Returns the point of intersection of a line defined by
;; points p1,p2 and a plane defined by its origin and normal
(defun LM:IntersLinePlane ( p1 p2 org nm )
   (setq org (trans org 0 nm)
         p1  (trans p1  0 nm)
         p2  (trans p2  0 nm)
   )
   (trans
       (inters p1 p2
           (list (car p1) (cadr p1) (caddr org))
           (list (car p2) (cadr p2) (caddr org))
           nil
       )
       nm 0
   )
)
;; Vector Cross Product  -  Lee Mac
;; Args: u,v - vectors in R^3
(defun v^v ( u v )
   (list
       (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
       (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
   )
)
;; Unit Vector  -  Lee Mac
;; Args: v - vector in R^2 or R^3
(defun v1 ( v )
   (   (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
       (distance '(0.0 0.0 0.0) v)
   )
)
(defun c:Z3 ( / p1 p2 p3 pc pcv norvec1plane pcc z )
 (setq p1 (getpoint "\nPick first plane point : ")
       p2 (getpoint "\nPick second plane point : ")
       p3 (getpoint "\nPick third plane point : ")
       pc (getpoint "\nPick 2d point to project it to plane : ")
 )
 (setq pcv (list (car pc) (cadr pc) (+ (caddr pc) 1.0)))
 (setq norvec1plane (v1 (v^v (mapcar '- p3 p1) (mapcar '- p2 p1))))
 (setq pcc (LM:IntersLinePlane pc pcv p1 norvec1plane))
 (setq z (rtos (caddr pcc) 2 3))
 (command "_.point" pcc)
 (command "text" pcc 5.0 "0" (strcat "  " z))
 (princ)
)