(defun chuli(dxf pt / a1 a1x a1y a2 a2x a2y ae ang1 as cc cl d dx dxf10list dy ex ey i p p1 p2 p3 pe ps qx qy r r1 r2 s sx sy)
(setq
qx (car pt)
qy (cadr pt)
ang1 (* pi (/ ang 180.0))
)
(if (equal '(0 . "LINE") (assoc 0 dxf)) ;if-1
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
ex (- (cadr (assoc 11 dxf)) qx)
ey (- (caddr (assoc 11 dxf)) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ex (+ (+ ex (* ey (cos ang1))) qx)
ey (+ (* ey (sin ang1)) qy)
ps (cons 10 (list sx sy 0))
pe (cons 11 (list ex ey 0))
dxf(subst ps (assoc 10 dxf) dxf)
dxf(subst pe (assoc 11 dxf) dxf)
)
(entmod dxf)
)
) ;endif-1
(if (equal '(0 . "CIRCLE") (assoc 0 dxf)) ;if-2
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
r(cdr (assoc 40 dxf))
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
r1 (* (sqrt (+ 1 (cos ang1))) r)
r2 (* (sqrt (- 1 (cos ang1))) r)
p(list sx sy)
p1 (polar p (/ ang1 2) r1)
p2 (polar p (/ ang1 2) (- 0.0 r1))
p3 (polar p (/ (+ ang1 pi) 2) r2)
cl (cdr (assoc 8 dxf))
cc (cdr (assoc 62 dxf))
)
(setvar "clayer" cl)
(if cc
(command "setvar" "cecolor" cc)
(setvar "cecolor" "BYLAYER")
)
(command "_ellipse" p1 p2 p3)
(entdel name)
)
) ;endif-2
(if (equal '(0 . "ARC") (assoc 0 dxf)) ;if-3
(progn
(setq
sx(- (cadr (assoc 10 dxf)) qx)
sy(- (caddr (assoc 10 dxf)) qy)
as(cdr (assoc 50 dxf))
ae(cdr (assoc 51 dxf))
r (cdr (assoc 40 dxf))
s (list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
a1(polar s as r)
a2(polar s ae r)
a1x (- (car a1) qx)
a1y (- (cadr a1) qy)
a2x (- (car a2) qx)
a2y (- (cadr a2) qy)
a1x (+ (+ a1x (* a1y (cos ang1))) qx)
a1y (+ (* a1y (sin ang1)) qy)
a2x (+ (+ a2x (* a2y (cos ang1))) qx)
a2y (+ (* a2y (sin ang1)) qy)
a1(list a1x a1y)
a2(list a2x a2y)
sx(+ (+ sx (* sy (cos ang1))) qx)
sy(+ (* sy (sin ang1)) qy)
r1(* (sqrt (+ 1 (cos ang1))) r)
r2(* (sqrt (- 1 (cos ang1))) r)
p (list sx sy)
p1(polar p (/ ang1 2) r1)
p2(polar p (/ ang1 2) (- 0.0 r1))
p3(polar p (/ (+ ang1 pi) 2) r2)
as(angtos (- (angle p a1) (/ ang1 2)) 0 4)
ae(angtos (- (angle p a2) (/ ang1 2)) 0 4)
cl(cdr (assoc 8 dxf))
cc(cdr (assoc 62 dxf))
)
(setvar "clayer" cl)
(if cc
(command "setvar" "cecolor" cc)
(setvar "cecolor" "BYLAYER")
)
(command "_ellipse" "a" p1 p2 p3 as ae)
(entdel name)
)
) ;endif-3
(if (equal '(0 . "TEXT") (assoc 0 dxf)) ;if-4
(progn
(if (= (cdr (assoc 72 dxf)) 5)
(setq ex (cadr (assoc 11 dxf))
ey (caddr (assoc 11 dxf))
)
(setq ex (car (polar
(list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
(cdr (assoc 50 dxf))
1000
)
)
ey (cadr
(polar
(list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
(cdr (assoc 50 dxf))
1000
)
)
)
)
(setq
sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ex (- ex qx)
ey (- ey qy)
ex (+ (+ ex (* ey (cos ang1))) qx)
ey (+ (* ey (sin ang1)) qy)
dx (- (cadr (assoc 11 dxf)) qx)
dy (- (caddr (assoc 11 dxf)) qy)
dx (+ (+ dx (* dy (cos ang1))) qx)
dy (+ (* dy (sin ang1)) qy)
as (angle (list sx sy) (list ex ey))
dxf(subst (cons 10 (list sx sy 0)) (assoc 10 dxf) dxf)
dxf(subst (cons 11 (list dx dy 0)) (assoc 11 dxf) dxf)
dxf(subst (cons 50 as) (assoc 50 dxf) dxf)
)
(entmod dxf)
)
) ;endif-4
(if (equal '(0 . "LWPOLYLINE") (assoc 0 dxf)) ;if-5
(progn
(setq
dxf10list(vl-remove-if-not ;提取选择集能通过测试的表
'(lambda (x) (eq 10 (car x)));测试函数
dxf)
)
(foreach n dxf10list
(setq
sx (- (cadr n) qx)
sy (- (caddr n) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ps (cons 10 (list sx sy 0))
dxf(subst ps n dxf)
)
)
(entmod dxf)
)
) ;endif-5
(if (equal '(0 . "INSERT") (assoc 0 dxf)) ;if-6
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ps (cons 10 (list sx sy 0))
dxf(subst ps (assoc 10 dxf) dxf)
)
(entmod dxf)
)
)
)
;====================
(command "UNDO""be")
(setq
cmd (getvar "cmdecho")
osm (getvar "osmode")
clay (getvar "clayer")
cecol (getvar "cecolor")
)
(graphscr)
(setq ang (getreal (strcat "\n输入轴侧<45>(度):")))
(if (= ang nil)
(setq ang 45.0
)
)
(princ "\n选择图素:")
(setq ss (ssget '(
(0 . "line,circle,arc,text,LWPOLYLINE,INSERT")
)
)
pt (getpoint (strcat "\n输入标准点:"))
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "PELLIPSE" 0)
(if ss ;if
(progn
(setq n(sslength ss)
i 0
)
(while (< i n) ;while-2
(setq name(ssname ss i)
dxf (entget name)
)
(chuli dxf pt)
(setq i (1+ i))
) ;while-2
)
(princ "/n选择错误!")
) ;endif
(setvar "cmdecho" cmd)
(setvar "osmode" osm)
(setvar "clayer" clay)
(setvar "cecolor" cecol)
(command "UNDO""e")
(princ)
);添加了多段线，但块还是不行
页:
1
[2]