[编程交流] 理论和实际X点

[color="green"];; Make Angle Readable by: ymg  [/color]
(defun MakeReadable (a)
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
 (+ a pi)
 a
 ) 
      (+ pi pi)
      ) 
 ) 
(defun _mirror (x / en ie)[color="green"] ;*global variable= s & ip[/color] 
[color="green"] ;simply calling standard command "mirror" to manipulate or flip the reference annotation[/color]
   (cons 'progn
  (list        (cons 'setq '(ie 0))
        (cons 'repeat
              (list (sslength s)
                    (cons 'vl-cmdf
                          (list        "_.mirror"
                                '(setq en (ssname s ie))
                                ""
                                (cons 'list ip)
                                (cons 'polar (list (cons 'list ip) x 1.0))
                                "Y"
                                ) 
                          ) 
                    (cons 'setq '(ie (1+ ie)))
                    ) 
              ) 
        ) 
  ) 
   ) ;_ end of defun
(defun delta (p1 p2 ip / xy id dxy s i a l e)
;hanhphuc 
     (setq xy     '((p) (list (car p) (cadr p)))
    id        (mapcar        ''((x) (equal x (apply 'mapcar (cons '>= (mapcar 'xy (list p2 p1))))))
                '((T T) (nil T) (nil nil) (T nil))
                )
    
    dxy        (mapcar '- p1 p2)
    
    s        (apply ''((txh pt dX dY / ss next ro yd p) 
                  (setvar 'osmode 0) 
                  (setq
                   yd
                   (getvar 'ucsydir)
                   ro
                   (MakeReadable
                    (if
                     (equal (car yd) 0.0 1e-10)
                     0.0
                     (atan (/ (car yd) (cadr yd)))
                     ) 
                    )
                   )
                  
[color="green"] ; Draw arrow by standard command: PLINE [/color]
                  (vl-cmdf
                   "_PLINE"
                   (list (car pt) (+ (cadr pt) (* 2. txh)))
                   "w"
                   0.0
                   (* 0.3 txh)
                   (list (car pt) (+ (cadr pt) txh))
                   "w"
                   0.0
                   0.0
                   pt
                   "w"
                   0.0
                   0.0
                   (list (+ (car pt) txh) (cadr pt))
                   "w"
                   (* 0.3 txh)
                   0.0
                   (list (+ (car pt) (* 2. txh)) (cadr pt))
                   ""
                   ) ; command
                  
                  (setq next (ssadd))
                  (foreach
                   ss
                   (vl-list*
                    (entlast)
                    (mapcar
                     ''((a b c d)
                        (entmakex
                         (mapcar
                          'cons
                          '(0 1 8 10 11 40 50 62 72 73) 
                          (list "TEXT" a "DIFF" (setq p (polar (trans pt 1 0) (- b ro) c)) p txh (- d ro) 256 1 2)
                          )
                         )
                        )
                     (list dY dX)
                     (list  (* pi 0.5) 0.) 
                     (list (* 4.0 txh) (* 4.0 txh)) 
                     (list (* pi 0.5) 0.0)
                     
                     ) ; mapcar  
                    ) ; vl-list* 
                   (ssadd ss next)
                   ) 
                  next
                  ) 
               (vl-list* (getvar 'textsize)
                         ip
                         (mapcar ''((f) (rtos (abs (* (f dxy) 1000.)) 2 0)) (list car cadr))
                         )
               )
    ) 
     (eval (cons 'cond
          (vl-list* (list (nth 0 id) T)
                    (mapcar ''((a b)
                               (list
                                (setq i (nth a id))
                                (_mirror b)
                                (if
                                 (and i (nth 2 id))
                                 (_mirror (* pi 0.5))
                                 )
                                )
                               )
                            '(1 2 3)
                            (list (* pi 0.5) 0.0 pi)
                            )
                    )
          ) 
    ) ;eval
    (repeat (setq i (sslength s))
   (setq e (ssname s (setq i (1- i)))
  l (entget e)
  a (cdr (assoc 50 l))
  ) 
   (if        (assoc 1 l)
     (entmod (subst (cons 50 (MakeReadable a)) (assoc 50 l) l))
     ) 
   ) ;repeat
     )
(defun c:test (/ p1 p2 p3 )
 (terpri)
 (while (and (setq p1 (getpoint "\rTheoretical point..       "))
      (setq p2 (getpoint p1 "\rActual point..            "))
      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
      )
   (delta p1 p2 p3)
   ) 
 (princ)
 ) 

(defun c:foo (/ _text d p1 p2 s)
 (defun _text (p h s)
   (entmakex (list '(0 . "TEXT")
            '(100 . "AcDbEntity")
            '(67 . 0)
            '(62 . 1)
            '(8 . "text")
            '(100 . "AcDbText")
            (cons 10 p)
            (cons 40
                  (if (> (getvar 'dimscale) 0)
                    (* h (getvar 'dimscale))
                    h
                  )
            )
            (cons 1 (vl-princ-to-string s))
            '(50 . 0.0)
            '(41 . 1.0)
            '(51 . 0.0)
            '(7 . "Standard")
            '(71 . 0)
            '(72 . 1)
            (cons 11 p)
            '(100 . "AcDbText")
            '(73 . 2)
      )
   )
 )
 (if (setq s (ssget '((0 . "point"))))
   (progn (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
                   (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
           )
         s (vl-sort s '(lambda (a b) (< (cadr a) (cadr b))))
   )
   (while (cadr s)
     (setq p1 (car s))
     (setq
       p2 (car (vl-sort (setq s (cdr s)) '(lambda (a b) (< (distance p1 a) (distance p1 b)))))
     )
     (setq d (mapcar 'abs (mapcar '- p1 p2)))
     (entmakex (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(67 . 0)
                     '(62 . 
                     '(8 . "difference")
                     '(100 . "AcDbPolyline")
                     '(90 . 3)
                     (cons 10 p1)
                     (cons 10 (list (car p2) (cadr p1)))
                     (cons 10 p2)
               )
     )
     (_text p1 0.1 (car d))
     (_text p2 0.1 (cadr d))
     (setq s (vl-remove p2 s))
   )
   )
 )
 (princ)
)