考虑osmode angdir mirrtext等。。
;; Make Angle Readable by: ymg
(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) ;*global variable= s & ip
;simply calling standard command "mirror" to manipulate or flip the reference annotation
(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)))
)
)
)
; Draw arrow by standard command: PLINE
(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)
)
你好
这是olmosta完成的，但，是否可以这样编辑代码：activ osnap保持不变，数字始终是同一个方向！
最好的
马格斯
页:
1
[2]