[编程交流] 箭头在线

(defun c:pidarrow (/ ent      entname      point
            npoint      points       pt1
            pt2      anglepts     arrowstart1
            arrowstart2  arrowstart3 arrowstart4
            pointssecond)
(and
(setq Ent     (entsel "\nSelect Line near Arrow End: "))
(setq Point   (cadr Ent)
     EntName (car Ent)
     Ent     (entget EntName)
);setq
(= (cdr (assoc 0 Ent)) "LINE")
(progn
(setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent)));10=start pt of line, 11=end pt of line
Pt1 (cdr (assoc 10 Ent))
Pt2 (cdr (assoc 11 Ent))
AnglePts (angle Pt1 Pt2)
ArrowStart1 (polar  Pt1   (+ AnglePts  pi ) -2.5)
ArrowStart2 (polar  Pt2   (- AnglePts  pi ) 2.5)
Points (list  ArrowStart1 ArrowStart2)
ArrowStart3 (polar  ArrowStart1   (+ AnglePts  pi ) -2.5)
ArrowStart4  (polar  ArrowStart2   (- AnglePts  pi ) 2.5)
PointsSecond (list   ArrowStart3 ArrowStart4))
(if (< (distance Point (car Points))
      (distance Point (cadr Points))
)
(setq Points (reverse Points))
);if
(entmakex
(append
(list   (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
);list
(list   (cons 100 "AcDbPolyline")
       (cons 90 4);number of vertices?
       (cons 70 0)
);list
(mapcar (function (lambda (p)
       (cons 10 p))) Points)
(list   (cons 40 0.833333); width of arrow
       (cons 41 0.0)
       (cons 10 (setq npoint (polar (cadr Points) (apply 'angle Points) 2.5)));length of arrow
   );list
(if (or (= (setq op (strcase (getstring "\nDo you want a double arrow head? (Yes or No): "))) "Y")
       (= op "YES"))
 (list   (cons 40 0.833333); width of arrow
       (cons 41 0.0)
       (cons 10 (polar npoint (apply 'angle Points) 2.5)))
);if
);append
);entmakex
);progn
(entdel EntName)
(princ)
);and
)
;defun

(defun c:pidarrow (/ Ent EntName Point pang npoint p1 points )
 (and
   (setq Ent (entsel "\nSelect Line near Arrow End: "))
   (setq Point      (cadr Ent)
     EntName (car Ent)
     Ent      (entget EntName)
     )
   (= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
        (distance Point (cadr Points))
        )
   (setq Points (reverse Points))
   )
     (entmakex
   (append
     (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
     (list (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0))
     (if (or (= (setq op (strcase (getstring "\nDo you want a double arrow head? (Yes or No): "))) "Y")
         (= op "YES"))
       (list (cons 10 (setq p1 (car points)))
         (cons 10 (setq npoint (polar  p1 (setq pang (apply 'angle Points)) (- (distance p1 (cadr points)) 16.0)))))
       (list (cons 10 (setq p1 (car points)))
         (cons 10 (setq npoint (polar  p1 (setq pang (apply 'angle Points)) (- (distance p1 (cadr points)) 8.0))))))
     
     (list (cons 40 2.0); width of arrow
       (cons 41 0.0)
       (cons 10 (setq npoint (polar npoint pang 8.0))));length of arrow
     (if (or (= op "Y")
         (= op "YES"))
       (list (cons 40 2.0); width of arrow
         (cons 41 0.0)
         (cons 10 (polar npoint pang 8.0)))
       ))))
   (entdel EntName)
   (princ)
   )
 )

7