;;;自動標注 *

;;;=================================================================*

;;;思路：1.選擇對象 *

;;; 2.指定基點 *

;;; 3.輸入比例 *

;;; 4.獲取特征點坐標 *

;;; 5.提煉 X 坐標，并排序 *

;;; 6.提煉 Y 坐標，并排序 *

;;; 7.標注 *

;;;=================================================================*

;;; 總控 zml84 于 2009-05-07 *

(defun C:TT ()

(if(and (setq SS (ssget)) ;_'((0 . "LINE,ARC,PLINE"))

(setq PT0 (getpoint "\n指定基點: "))

(setq SC (getreal "\n輸入比例: "))

)

(progn

(setq LST_PT (TT-04 SS))

(setq LST_X(TT-05 LST_PT)

LST_Y(TT-06 LST_PT)

)

(TT-07 LST_X LST_Y PT0 SC)

)

)

(princ)

)

;;;=================================================================*

;;; 4.獲取特征點坐標 *

(defun TT-04 (SS / LST_PT I ENT N PT)

(setq LST_PT '()

I 0

)

(repeat (sslength SS)

(setq ENT (entget (ssname SS I)))

(foreach N ENT

(if(<= 10 (car N) 19)

(setq PT (cdr N)

LST_PT (cons PT LST_PT)

)

)

)

(setq I (1+ I))

)

;;返回

(reverse LST_PT)

)

;;;=================================================================*

;;; 5.提煉 X 坐標，并排序 *

(defun TT-05 (LST_PT / LST_X PT X Y TMP)

(setq LST_X '())

(foreach PTLST_PT

(setq X(car PT)

Y(cadr PT)

)

(if (setq TMP (assoc X LST_X))

(setq LST_X (subst (append (list X Y) (cdr TMP)) TMP LST_X))

(setq LST_X (cons (list X Y) LST_X))

)

)

;;排序

(setq LST_X(mapcar'(lambda (E1)

(cons (car E1) (vl-sort (cdr E1) '

)

LST_X

)

)

(setq LST_X(vl-sort LST_X

'(lambda (E1 E2)

(< (car E1) (car E2))

)

)

)

;;返回

LST_X

)

;;;=================================================================*

;;; 6.提煉 Y 坐標，并排序 *

(defun TT-06 (LST_PT / LST_Y PT Y Y TMP)

(setq LST_Y '())

(foreach PTLST_PT

(setq X(car PT)

Y(cadr PT)

)

(if (setq TMP (assoc Y LST_Y))

(setq LST_Y (subst (append (list Y X) (cdr TMP)) TMP LST_Y))

(setq LST_Y (cons (list Y X) LST_Y))

)

)

;;排序

(setq LST_Y(mapcar'(lambda (E1)

(cons (car E1) (vl-sort (cdr E1) '

)

LST_Y

)

)

(setq LST_Y(vl-sort LST_Y

'(lambda (E1 E2)

(< (car E1) (car E2))

)

)

)

;;返回

LST_Y

)

;;;=================================================================*

;;; 7.標注 *

(defun TT-07 (LST_X LST_Y PT0 SC / TMP X Y PT STR X_LAST PT1)

;;標注 X

(setq X_LAST (caar LST_X))

(foreach TMP LST_X

(setq X (car TMP)

Y (cadr TMP)

PT (list X Y)

STR (rtos (* SC (- X (car PT0))))

)

(setq X_LAST (max X X_LAST)

PT1 (list X_LAST (- (cadr PT0) (* 1.0 SC))) ;_標注點

X_LAST (+X_LAST

(* 2 (getvar "dimtxt") (getvar "dimscale"))

)

)

(command "_dimordinate" "non" PT "x" "t" STR "non" PT1)

)

;;標注 Y

(setq Y_LAST (caar LST_Y))

(foreach TMP LST_Y

(setq Y (car TMP)

X (cadr TMP)

PT (list X Y)

STR (rtos (* SC (- Y (cadr PT0))))

)

(setq Y_LAST (max Y Y_LAST)

PT1 (list (- (car PT0) (* 1.0 SC)) Y_LAST) ;_標注點

Y_LAST (+Y_LAST

(* 2 (getvar "dimtxt") (getvar "dimscale"))

)

)

(command "_dimordinate" "non" PT "Y" "t" STR "non" PT1)

)

)

;;;=================================================================*

總結

以上是生活随笔為你收集整理的冲压模板自动标注LISP_自动标注.LSP的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。