[编程交流] （3） 三维点到UCS拉伸

;; Linearp (gile)
;; Evaluates if all points in the list are colinear
;;
;; Arguments: a points list
(defun linearp (lst / v1 v2)
 (or
   (null (cddr lst))
   (and (or
      (null (setq v1 (Normalize (mapcar '- (cadr lst) (car lst)))))
      (null (setq v2 (Normalize (mapcar '- (caddr lst) (car lst)))))
      (equal v1 v2 1e-9)
      (equal v1 (mapcar '- v2) 1e-9)
    )
    (linearp (cdr lst))
   )
 )
)
;; Normalize
;; Returns the single unit vector of a vector
;;
;; Argument : a vector
(defun Normalize (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)

(if (setq normal (Norm_3pts p1 p2 p3))
 (princ (strcat "\nThe normal vector is: " (vl-princ-to-string normal)))
 (princ "\np1 p2 p3 are colinear, they do not define a plane")
)

[b][color=BLACK]([/color][/b]and
 [b][color=FUCHSIA]([/color][/b]setq i -1
      ss [b][color=NAVY]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]0 . [color=#2f4f4f]"3DFACE"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]1+ i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ed [b][color=MAROON]([/color][/b]entget en[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]foreach p '[b][color=MAROON]([/color][/b]10 11 12 13[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]set [b][color=GREEN]([/color][/b]read [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"P"[/color] [b][color=RED]([/color][/b]itoa p[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                       [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc p ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ocs [b][color=MAROON]([/color][/b]cond [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]is_pt_colinear p10 p11 p12 1e-8[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]normal p10 p11 p12[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]is_pt_colinear p10 p11 p13 1e-8[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]normal p10 p11 p13[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]not [b][color=RED]([/color][/b]is_pt_colinear p11 p12 p13 1e-8[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]normal p11 p12 p13[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b]T nil[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]and ocs
           [b][color=MAROON]([/color][/b]entmake [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"SOLID"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 62 256[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 6 [color=#2f4f4f]"BYLAYER"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 39 0[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 10 [b][color=RED]([/color][/b]trans p10 0 ocs[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 11 [b][color=RED]([/color][/b]trans p11 0 ocs[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 12 [b][color=RED]([/color][/b]trans p13 0 ocs[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 13 [b][color=RED]([/color][/b]trans p12 0 ocs[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]cons 210 ocs[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]entdel en[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(setq ocs (cond    ((normal p10 p11 p12))
       ((normal p10 p11 p13))
       ((normal p11 p12 p13))
     )
)

;; Triang3dFace
;; Divides a quadrangular 3d face into two triangular 3d faces and returns its ename
;; or 'normalise' a triangular one (3rd and 4th vertices overlapped) and returns nil.
;;
;; Argument : a 3d face (ENAME)
(defun Triang3dFace    (f3d / p1 p2 p3 p4)
 (setq    elst (entget f3d)
   p1   (cdr (assoc 10 elst))
   p2   (cdr (assoc 11 elst))
   p3   (cdr (assoc 12 elst))
   p4   (cdr (assoc 13 elst))
 )
 (cond
   ((equal p3 p4 1e-9) nil)
   ((equal p1 p2 1e-9)
    (entmod (subst (cons 11 p3)
           (assoc 11 elst)
           (subst (cons 12 p4) (assoc 12 elst) elst)
        )
    )
    nil
   )
   ((equal p1 p4 1e-9)
    (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
    nil
   )
   (T
    (if (< (distance p2 p4) (distance p1 p3))
      (progn
    (entmod
      (subst (cons 12 p4) (assoc 12 elst) elst)
    )
    (entmakex
      (subst (cons 10 p2)
         (assoc 10 elst)
         (subst (cons 11 p3)
            (assoc 11 elst)
            (subst (cons 12 p4) (assoc 12 elst) elst)
         )
      )
    )
      )
      (progn
    (entmod (subst (cons 13 p3) (assoc 13 elst) elst))
    (entmakex
      (subst (cons 11 p3)
         (assoc 11 elst)
         (subst (cons 12 p4) (assoc 12 elst) elst)
      )
    )
      )
    )
   )
 )
)
;; TRIFACE
;; Converts selected 3d faces in 'normalised' triangular faces
(defun c:TriFace (/ n ss ent)
 (if (and (setq n  -1
        ss (ssget '((0 . "3DFACE")))
      )
     )
   (while (setq ent (ssname ss (setq n (1+ n))))
     (Triang3dFace ent)
   )
 )
 (princ)
)