- 积分
- 1038
- 明经币
- 个
- 注册时间
- 2010-6-12
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
各位大大如何控制一下论坛分享的资料坐标标注的长度啊，，我每次标都跑出去图框了。那个代码是控制他的长度呢。谢谢大神们了
;;;自动坐标标注
(defun C:acc (/ err)
(command "UNDO" "BE")
(setq err (vl-catch-all-apply 'ac-autoDim nil))
(if (vl-catch-all-error-p err)
(progn
;; add some error handles here
)
)
(command "UNDO" "E")
)
;;;
;;; global variables: dd, posRec, stPos
;;; main function
(defun ac-autoDim(/ ss ent i inf pt-pairs xs ys x1 x2 y1 y2 xinfs yinfs xinf1 yinf1 xinf2 yinf2 cpt gap
dd posRec)
(setq ss (ssget)
pt (getpoint "\nBase point: ")
ent (ssname ss 0)
i 0
dd (* (getvar "DIMSCALE") (+ (getvar "DIMTXT") (* 2.0 (getvar "DIMGAP"))))
posRec (list nil nil nil nil nil nil nil nil)
)
(command "UCS" "O" pt)
(while ent
(setq inf (ac-dimInf ent))
(if inf
(progn
(setq xinf1 (nth 0 inf)
yinf1 (nth 1 inf)
xs (append (nth 2 inf) xs)
ys (append (nth 3 inf) ys)
)
(if xinf1
(progn
(setq xinf2 (assoc (car xinf1) xinfs))
(if xinf2
(setq xinfs (subst (list (car xinf2) (cadr xinf2) (append (nth 2 xinf2) (nth 2 xinf1))) xinf2 xinfs))
(setq xinfs (cons xinf1 xinfs))
)
)
)
(if yinf1
(progn
(setq yinf2 (assoc (car yinf1) yinfs))
(if yinf2
(setq yinfs (subst (list (car yinf2) (cadr yinf2) (append (nth 2 yinf2) (nth 2 yinf1))) yinf2 yinfs))
(setq yinfs (cons yinf1 yinfs))
)
)
)
)
)
(setq i (1+ i)
ent (ssname ss i)
)
)
;; find the center of objects
(setq x1 (apply 'min xs)
x2 (apply 'max xs)
y1 (apply 'min ys)
y2 (apply 'max ys)
cpt (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) 0.0)
gap (* 5.0 dd)
stPos (list (- x1 gap) (+ x2 gap) (- y1 gap) (+ y2 gap))
)
;; dimension
(setq xinfs (vl-sort xinfs '(lambda(a b) (< (abs (- (cadr a) (car cpt))) (abs (- (cadr b) (car cpt))))))
yinfs (vl-sort yinfs '(lambda(a b) (< (abs (- (cadr a) (cadr cpt))) (abs (- (cadr b) (cadr cpt))))))
)
(ac-dimInfs xinfs cpt "x")
(ac-dimInfs yinfs cpt "y")
(command "UCS" "P")
)
;;;
(defun ac-dimInf(ent / dat typ p1 p2 x1 y1 x2 y2 ang ang2 xs ys xinf yinf inf rad)
(setq dat (entget ent)
typ (cdr (assoc 0 dat))
)
(cond ((= typ "LINE")
(setq p1 (trans (cdr (assoc 10 dat)) 0 1)
p2 (trans (cdr (assoc 11 dat)) 0 1)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
ang (angle p1 p2)
ang2 (rem ang pi)
xs (list x1 x2)
ys (list y1 y2)
)
(cond ((or (equal ang2 0.0 0.01) (equal ang2 pi 0.01) (equal ang2 (* 2.0 pi) 0.01))
;; horizontal
(setq yinf (list (rtos y1 2 4) y1 (list x1 x2)))
)
((or (equal ang2 (* 0.5 pi) 0.01) (equal ang2 (* 1.5 pi) 0.01))
;; vertical
(setq xinf (list (rtos x1 2 4) x1 (list y1 y2)))
)
)
(setq inf (list xinf yinf xs ys))
)
((= typ "CIRCLE")
(setq p1 (trans (cdr (assoc 10 dat)) 0 1)
x1 (car p1)
y1 (cadr p1)
rad (cdr (assoc 40 dat))
xs (list (+ x1 rad) (- x1 rad))
ys (list (+ y1 rad) (- y1 rad))
xinf (list (rtos x1 2 4) x1 (list y1))
yinf (list (rtos y1 2 4) y1 (list x1))
inf (list xinf yinf xs ys)
)
)
)
inf
)
;;;
(defun ac-dimPtPair (p1 p2 cpt dir)
(if (> (distance p1 cpt) (distance p2 cpt))
(ac-dimOrd p1 (angle p2 p1) cpt dir)
(ac-dimOrd p2 (angle p1 p2) cpt dir)
)
)
;;;
(defun ac-dimPtSingle (pt cpt dir / v)
(setq v (mapcar '- pt cpt))
(cond ((= dir "y")
(if (> (car v) 0.0)
(ac-dimOrd pt 0.0 cpt dir)
(ac-dimOrd pt pi cpt dir)
)
)
((= dir "x")
(if (> (cadr v) 0.0)
(ac-dimOrd pt (* 0.5 pi) cpt dir)
(ac-dimOrd pt (* 1.5 pi) cpt dir)
)
)
)
)
;;;
(defun ac-dimInfs (infs cpt dir / a bs b1 b2 p1 p2)
(foreach inf infs
(setq a (cadr inf)
bs (vl-sort (nth 2 inf) '<)
)
(if (= (length bs) 1)
(cond ((= dir "x")
(setq p1 (list a (car bs) 0.0))
(ac-dimPtSingle p1 cpt dir)
)
((= dir "y")
(setq p1 (list (car bs) a 0.0))
(ac-dimPtSingle p1 cpt dir)
)
)
(cond ((= dir "x")
(setq p1 (list a (car bs) 0.0)
p2 (list a (last bs) 0.0)
)
(ac-dimPtPair p1 p2 cpt dir)
)
((= dir "y")
(setq p1 (list (car bs) a 0.0)
p2 (list (last bs) a 0.0)
)
(ac-dimPtPair p1 p2 cpt dir)
)
)
)
)
)
;;;
;;; global variables: dd, posRec
;;; stPos: (x1 x2 y1 y2)
(defun ac-dimOrd (pt ang cpt dir / area pp px py dd2 pp2)
(cond ((or (equal ang 0.0 0.001) (equal ang (* 2.0 pi) 0.001))
(if (> (cadr pt) (cadr cpt))
(setq area 7)
(setq area 6)
)
)
((equal ang pi 0.001)
(if (> (cadr pt) (cadr cpt))
(setq area 5)
(setq area 4)
)
)
((equal ang (* 0.5 pi) 0.001)
(if (> (car pt) (car cpt))
(setq area 3)
(setq area 2)
)
)
((equal ang (* 1.5 pi) 0.001)
(if (> (car pt) (car cpt))
(setq area 1)
(setq area 0)
)
)
)
(setq pp (nth area posRec))
(cond ((= area 0)
(setq px (car pt)
py (nth 2 stPos)
)
(if pp
(progn
(setq dd2 (- (- pp px) dd))
(if (< dd2 0.0)
(setq px (+ px dd2))
)
)
)
(setq pp2 px)
)
((= area 1)
(setq px (car pt)
py (nth 2 stPos)
)
(if pp
(progn
(setq dd2 (- (- px pp) dd))
(if (< dd2 0.0)
(setq px (- px dd2))
)
)
)
(setq pp2 px)
)
((= area 2)
(setq px (car pt)
py (nth 3 stPos)
)
(if pp
(progn
(setq dd2 (- (- pp px) dd))
(if (< dd2 0.0)
(setq px (+ px dd2))
)
)
)
(setq pp2 px)
)
((= area 3)
(setq px (car pt)
py (nth 3 stPos)
)
(if pp
(progn
(setq dd2 (- (- px pp) dd))
(if (< dd2 0.0)
(setq px (- px dd2))
)
)
)
(setq pp2 px)
)
((= area 4)
(setq px (nth 0 stPos)
py (cadr pt)
)
(if pp
(progn
(setq dd2 (- (- pp py) dd))
(if (< dd2 0.0)
(setq py (+ py dd2))
)
)
)
(setq pp2 py)
)
((= area 5)
(setq px (nth 0 stPos)
py (cadr pt)
)
(if pp
(progn
(setq dd2 (- (- py pp) dd))
(if (< dd2 0.0)
(setq py (- py dd2))
)
)
)
(setq pp2 py)
)
((= area 6)
(setq px (nth 1 stPos)
py (cadr pt)
)
(if pp
(progn
(setq dd2 (- (- pp py) dd))
(if (< dd2 0.0)
(setq py (+ py dd2))
)
)
)
(setq pp2 py)
)
((= area 7)
(setq px (nth 1 stPos)
py (cadr pt)
)
(if pp
(progn
(setq dd2 (- (- py pp) dd))
(if (< dd2 0.0)
(setq py (- py dd2))
)
)
)
(setq pp2 py)
)
)
;; reorder posRec
(setq posRec (mapcar '(lambda (i / r)
(if (= i area)
(setq r pp2)
(setq r (nth i posRec))
)
r
)
'(0 1 2 3 4 5 6 7)
)
)
;; dimension
(command "DIMORDINATE" "none" pt dir "none" (list px py 0.0))
)
|
|
发表于 2015-12-13 23:58
置顶卡
变色卡
显身卡
楼主