这样标注出来的数值为什么不能改精度
这是早几天在论坛发现的源码，标注出来的数值如果能改精度，对我还说还是比较实用的，可是我对这样不会改，望哪位好心人帮忙改一下，万分感谢; =================================================================;;; 自动坐标标注
;;; 原作者：zml84由langjs修改于2009-05-25命令：tt
;;; =================================================================
(defun C:ZB (/ chanshu001 ent ent1 i lst_1 lst_2 lst_3 lst_4 lst_pt lst_x lst_y lstlx lstly lstx1
lstx2 lsty1 lsty2 p001 p002 p003 p004 pmax pmay pminx pminy pt0 pt0linshijidian pzhx
pzhxl pzhy pzhyl sc snap ss ssguol uuu x_last xlins xxxx xzuih xzuihbak xzuihbak2
y_last ylins yyyy yzuih yzuihbak2 yzuihbak3 xsw
)
(setvar "cmdecho" 0) ; 关闭命令响应
(setq ss (ssget '((0 . "LINE,CIRCLE,PLINE,LWPOLYLINE,INSERT"))))
(setq PT0linshijidian '(0.0 0.0 0.0))
(setq PT0 (getpoint "\n指定基点: "))
(cond
((null PT0)
(setq PT0 PT0linshijidian)
)
((= PT0 0.0)
(setq PT0 PT0linshijidian)
)
)
(setq SC 1)
(setq SC (getreal "\n输入比例 <1>: "))
(cond
((null SC)
(setq SC 1)
)
((= uuu 0.0)
(setq SC 1)
)
)
(setq chanshu001 (* 7 (getvar "dimtxt") (getvar "dimscale")))
(setq uuu (atof (getstring (strcat "\n标注拉伸 <" (rtos chanshu001) ">:"))))
(cond
((null uuu)
(setq uuu chanshu001)
)
((= uuu 0.0)
(setq uuu chanshu001)
)
) ; 下面程序设置过滤虚线条件
(setq ssguol '("ACAD_ISO03W100" "ACAD_ISO02W100"
"DASHED" "DASHED2"
"DASHEDX2" "HIDDEN"
"HIDDEN2" "HIDDENX2"
)
) ; 下面程序将虚线图层加入虚线过滤条件
(setq ssguol (append
SSguol
(TT-01 "ACAD_ISO03W100")
(TT-01 "ACAD_ISO02W100")
(TT-01 "DASHED")
(TT-01 "DASHED2")
(TT-01 "DASHEDX2")
(TT-01 "HIDDEN")
(TT-01 "HIDDEN2")
(TT-01 "HIDDENX2")
)
) ; 下面程序将选择集中随层的虚线图层中的线过滤掉
(SETQ i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ent1 (entget ent))
(if (and
(member (cdr (assoc 8 ent1)) ssguol)
(/= (cdr (assoc 0 ent1)) "INSERT")
(= (assoc 6 ent1) nil)
)
(setq ss (ssdel ent ss))
(SETQ i (+ 1 i))
)
) ; 下面程序将选择集中其他层的虚线图元过滤掉
(SETQ i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ent1 (entget ent))
(if (member (cdr (assoc 6 ent1)) ssguol)
(setq ss (ssdel ent ss))
(SETQ i (+ 1 i))
)
) ; 主要程序
(vl-cmdf ".UNDO" "BE") ; 设置UNDO起点
(setq snap (getvar "osmode"))
(setvar "osmode" 0) ; 关闭捕捉
(setq xsw (getvar "DIMZIN"))
(setvar "DIMZIN" 0) ; 关闭小数点末尾数为0时候省略
(progn
(setq LST_PT (TT-02 ss))
(setq LST_PT (cons PT0 LST_PT)) ; 下面程序坐标分象限
(setq i 1
pminx (car (nth 0 LST_PT))
pmax pminx
pminy (cadr (nth 0 LST_PT))
pmay pminy
)
(while (<= i (length LST_PT))
(setq xxxx (car (nth (- i 1) LST_PT)))
(setq yyyy (cadr (nth (- i 1) LST_PT)))
(cond
((< xxxx pminx)
(setq pminx xxxx)
)
((> xxxx pmax)
(setq pmax xxxx)
)
((< yyyy pminy)
(setq pminy yyyy)
)
((> yyyy pmay)
(setq pmay yyyy)
)
(t
(princ)
)
)
(setq i (+ i 1))
) ; 求坐标范围中间数值
(setq pzhx (/ (+ pminx pmax) 2))
(setq pzhy (/ (+ pminy pmay) 2)) ; 求4个象限的坐标对齐点
(setq p001 (list (- pminx uuu) (- pminy uuu) 0.0)
p002 (list (- pminx uuu) (+ pmay uuu) 0.0)
p003 (list (+ pmax uuu) (- pminy uuu) 0.0)
p004 (list (+ pmax uuu) (+ pmay uuu) 0.0)
) ; 将坐标分类到四个象限
(setq i 0
LST_1 '()
LST_2 '()
LST_3 '()
LST_4 '()
)
(while (< i (length LST_PT))
(setq pzhxl (car (nth i LST_PT))
pzhyl (cadr (nth i LST_PT))
)
(if (and
(<= pzhxl pzhx)
(<= pzhyl pzhy)
)
(setq LST_1 (cons (nth i LST_PT) LST_1))
)
(if (and
(<= pzhxl pzhx)
(> pzhyl pzhy)
)
(setq LST_2 (cons (nth i LST_PT) LST_2))
)
(if (and
(> pzhxl pzhx)
(<= pzhyl pzhy)
)
(setq LST_3 (cons (nth i LST_PT) LST_3))
)
(if (and
(> pzhxl pzhx)
(> pzhyl pzhy)
)
(setq LST_4 (cons (nth i LST_PT) LST_4))
)
(setq i (+ i 1))
) ; 坐标分象限结束
(setq Xlins '(0.0)
Ylins '(0.0)
)
(setq LSTX1 '()
LSTX2 '()
LSTY1 '()
LSTY2 '()
)
(setq LST_X (TT-03 LST_1)
LST_Y (TT-04 LST_1)
)
(setq LST_X (TT-10 SS LST_X)
LST_Y (TT-11 SS LST_Y)
)
(setq X_LAST (caar LST_X))
(setq Y_LAST (caar LST_Y))
(TT-07 LST_X LST_Y PT0 SC p001)
(setq LSTX1 (append
LSTX1
(reverse LSTLX)
)
)
(setq LSTY1 (append
LSTY1
(reverse LSTLY)
)
)
(setq Xzuihbak Xzuih)
(setq LST_X (TT-05 LST_2)
LST_Y (TT-04 LST_2)
)
(setq LST_X (TT-10 SS LST_X)
LST_Y (TT-11 SS LST_Y)
)
(setq X_LAST (caar LST_X))
(TT-07 LST_X LST_Y PT0 SC p002)
(setq LSTX2 (append
LSTX2
(reverse LSTLX)
)
)
(setq LSTY1 (append
LSTY1
(reverse LSTLY)
)
)
(setq Xzuihbak2 Xzuih)
(setq Yzuihbak2 Yzuih)
(setq LST_X (TT-03 LST_3)
LST_Y (TT-06 LST_3)
)
(setq LST_X (TT-10 SS LST_X)
LST_Y (TT-11 SS LST_Y)
)
(setq X_LAST Xzuihbak)
(setq Y_LAST (caar LST_Y))
(TT-07 LST_X LST_Y PT0 SC p003)
(setq LSTX1 (append
LSTX1
(reverse LSTLX)
)
)
(setq LSTY2 (append
LSTY2
(reverse LSTLY)
)
)
(setq Yzuihbak3 Yzuih)
(setq X_LAST Xzuihbak2)
(setq LST_X (TT-05 LST_4)
LST_Y (TT-06 LST_4)
)
(if (= Yzuihbak2 Yzuihbak3)
(setq Y_LAST (caar LST_Y))
(setq Y_LAST Yzuihbak3)
)
(setq LST_X (TT-10 SS LST_X)
LST_Y (TT-11 SS LST_Y)
)
(TT-07 LST_X LST_Y PT0 SC p004)
(setq LSTX2 (append
LSTX2
(reverse LSTLX)
)
)
(setq LSTY2 (append
LSTY2
(reverse LSTLY)
)
)
)
(TT-12 LSTX1 PT0)
(TT-13 LSTY1 PT0)
(TT-12 LSTX2 PT0)
(TT-13 LSTY2 PT0)
(vl-cmdf ".UNDO" "E") ; 设置UNDO终点
(setvar "osmode" snap)
(setvar "DIMZIN" xsw)
(princ)
)
;;; =================================================================
;;; 获取包含指定线型的图层
(defun TT-01 (xianxing / layers)
(setq layers '())
(setq layers (get_layer_linetype xianxing)) ; 获取包含指定线型的图层
layers
)
(defun get_layer (/ layer_info layers) ; 返回当前图纸中图层信息
(setq layer_info (tblnext "layer" t))
(while (/= layer_info nil)
(setq layers (append
layers
(list layer_info)
)
)
(setq layer_info (tblnext "layer"))
)
layers
)
(defun get_layer_linetype (linetype / ly_info ly_infos tmplist) ; 提取包含指定线型的图层
(setq ly_Infos (get_layer))
(foreach ly_info ly_Infos
(if (= linetype (substr (cdr (assoc 6 ly_info)) 1 (strlen linetype)))
(setq tmplist (append
tmplist
(list (CDR (assoc 2 ly_info)))
)
)
)
)
tmplist
)
;;; =================================================================
;;; 获取特征点坐标
(defun TT-02 (SS / ent i lst_pt lstl 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))
)
(setq i 0
LSTL '()
)
(while (< i (length LST_PT))
(setq LSTL (cons (list (car (nth i LST_PT)) (cadr (nth i LST_PT)) 0.0) LSTL))
(setq i (+ 1 i))
)
(setq LST_PT LSTL) ; 返回
(reverse LST_PT)
)
;;; =================================================================
;;; 提炼 X 坐标，并排序
(defun TT-03 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
(setq LST_X '())
(foreach PT LST_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))
)
)
)
(setq i 0
LSTL '()
)
(while (< i (length LST_X))
(setq LSTL (cons (list (car (nth i LST_X)) (cadr (nth i LST_X)) 0.0) LSTL))
(setq i (+ 1 i))
)
(setq LST_X (reverse LSTL)) ; 返回
LST_X
)
;;; =================================================================
;;; 提炼 Y 坐标，并排序
(defun TT-04 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
(setq LST_Y '())
(foreach PT LST_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))
)
)
)
(setq i 0
LSTL '()
)
(while (< i (length LST_Y))
(setq LSTL (cons (list (car (nth i LST_Y)) (cadr (nth i LST_Y)) 0.0) LSTL))
(setq i (+ 1 i))
)
(setq LST_Y (reverse LSTL)) ; 返回
LST_Y
)
;;; =================================================================
;;; 提炼 X 坐标，并排序(由大到小)
(defun TT-05 (LST_PT / e1 e2 i lst_x lstl pt tmp x y)
(setq LST_X '())
(foreach PT LST_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))
)
)
)
(setq i 0
LSTL '()
)
(while (< i (length LST_X))
(setq LSTL (cons (list (car (nth i LST_X)) (nth (- (length (nth i LST_X)) 1) (nth i LST_X)) 0.0)
LSTL
)
)
(setq i (+ 1 i))
)
(setq LST_X (reverse LSTL)) ; 返回
LST_X
)
;;; =================================================================
;;; 提炼 Y 坐标，并排序 (由大到小)
(defun TT-06 (LST_PT / e1 e2 i lst_y lstl pt tmp x y)
(setq LST_Y '())
(foreach PT LST_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))
)
)
)
(setq i 0
LSTL '()
)
(while (< i (length LST_Y))
(setq LSTL (cons (list (car (nth i LST_Y)) (nth (- (length (nth i LST_Y)) 1) (nth i LST_Y)) 0.0)
LSTL
)
)
(setq i (+ 1 i))
)
(setq LST_Y (reverse LSTL)) ; 返回
LST_Y
)
;;; =================================================================
;;; 标注
(defun TT-07 (LST_X LST_Y PT0 SC ppp / ent pt pt1 str tmp x y) ; 标注 X
(setq LSTLX '()
LSTLY '()
)
(foreach TMP LST_X
(setq X (car TMP)
Y (cadr TMP)
PT (list X Y 0.0) ; STR (rtos (* SC (- X (car
; PT0))));;标注的数据为实际数值
STR (rtos (TT-09 (* SC (- X (car PT0))) 2)) ; 标注的数据保留小数点后2位
)
(if (and
(/= (TT-09 X 4) (TT-09 (car Xlins) 4))
(not (member (TT-09 X 4) Xlins))
)
(progn
(setq X_LAST (max
X
X_LAST
)
PT1 (list X_LAST (- (cadr PT0) (* 1.0 SC)) 0.0) ; _标注点
X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
; ?
; 小
)
(setq Xlins (cons (TT-09 X 4) Xlins))
(setq Xzuih X_LAST) ; (vl-cmdf "_dimordinate" PT "x" "t"STR PT1)
; ;;标注负号
(vl-cmdf "_dimordinate" PT "x" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
(setq ent (entlast))
(setq LSTLX (cons ent LSTLX))
(TT-08 ent ppp PT0) ; 对齐坐标
)
)
) ; 标注 Y
(foreach TMP LST_Y
(setq Y (car TMP)
X (cadr TMP)
PT (list X Y 0.0) ; STR (rtos (* SC (- Y (cadr PT0))))
; ;;标注的数据为实际数值
STR (rtos (TT-09 (* SC (- Y (cadr PT0))) 2)) ; 标注的数据保留小数点后2位
)
(if (and
(/= (TT-09 Y 4) (TT-09 (car Ylins) 4))
(not (member (TT-09 Y 4) Ylins))
)
(progn
(setq Y_LAST (max
Y
Y_LAST
)
PT1 (list (- (car PT0) (* 1.0 SC)) Y_LAST 0.0) ; _标注点
Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))) ; 调整1.5调整标注间距?
; ?
; 小
)
(setq Ylins (cons (TT-09 Y 4) Ylins))
(setq Yzuih Y_LAST) ; (vl-cmdf "_dimordinate" PT "Y" "t"STR PT1)
; ;;标注负号
(vl-cmdf "_dimordinate" PT "Y" "t" (rtos (abs (atof STR)) 2 2) PT1) ; 不标注负号
(setq ent (entlast))
(setq LSTLY (cons ent LSTLY))
(TT-08 ent ppp PT0) ; 对齐坐标
)
)
)
)
;;; =================================================================
;;; 点坐标对齐
(defun TT-08 (ent p0 PT0 / np14 p0x p0y p14x p14y p70) ; 点坐标对齐
(setq ent (entget ent))
(setq p70 (cdr (assoc 70 ent))
p14x (car (cdr (assoc 14 ent)))
p14y (cadr (cdr (assoc 14 ent)))
)
(setq p0x (car p0)
p0y (cadr p0)
)
(cond
((= p70 38.0)
(setq np14 (list p0x p14y 0.0))
)
((= p70 102.0)
(setq np14 (list p14x p0y 0.0))
)
(t
(exit)
)
)
(setq ent (subst
(cons 14 nP14)
(assoc 14 ent)
ent
)
)
(setq ent (subst
(cons 10 PT0)
(assoc 10 ent)
ent
)
)
(entmod ent)
(princ)
)
;;; =================================================================
;;; 四舍五入函数，ent:实数，n：小数点保留位数
(defun TT-09 (ent n / fh)
(if (>= ent 0.0)
(setq FH +)
(setq FH -)
)
(setq ent (/ (atof (itoa (fix (fh (* ent (expt 10 n)) 0.5)))) (expt 10 n)))
ent
)
;;; =================================================================
;;; 优化中心线点X坐标
(defun TT-10 (ss xxx / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
(setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
"CENTER" "CENTER2"
"CENTERX2" "DASHDOT"
"DASHDOT2" "DASHDOTX2"
)
) ; 下面程序将中心线图层加入一个列表
(setq ssguol2 (append
SSguol2
(TT-01 "ACAD_ISO04W100")
(TT-01 "ACAD_ISO08W100")
(TT-01 "CENTER")
(TT-01 "CENTER2")
(TT-01 "CENTERX2")
(TT-01 "DASHDOT")
(TT-01 "DASHDOT2")
(TT-01 "DASHDOTX2")
)
) ; 下面程序将选择集中随层的中心线加入一个列表
(SETQ i 0
PTzhongxinX '()
PTzhongxinY '()
)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ent1 (entget ent))
(if (or
(and
(member (cdr (assoc 8 ent1)) ssguol2)
(/= (cdr (assoc 0 ent1)) "INSERT")
(= (assoc 6 ent1) nil)
)
(member (cdr (assoc 6 ent1)) ssguol2)
)
(progn
(setq X1 (car (cdr (assoc 10 ent1)))
Y1 (cadr (cdr (assoc 10 ent1)))
X2 (car (cdr (assoc 11 ent1)))
Y2 (cadr (cdr (assoc 11 ent1)))
)
(if (= Y1 Y2)
(progn
(setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
(setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
)
)
(if (= X1 X2)
(progn
(setq PTzhongxinY (cons (list X1 Y1 0.0) PTzhongxinY))
(setq PTzhongxinY (cons (list X2 Y2 0.0) PTzhongxinY))
)
)
)
)
(SETQ i (+ 1 i))
)
(SETQ i 0)
(while (< i (length PTzhongxinX))
(if (member (nth i PTzhongxinX) xxx)
(SETQ xxx (vl-remove (nth i PTzhongxinX) xxx))
)
(SETQ i (+ 1 i))
)
xxx
)
;;; =================================================================
;;; 优化中心线点Y坐标
(defun TT-11 (ss yyy / ent ent1 i ptzhongxinx ptzhongxiny ssguol2 x1 x2 y1 y2)
(setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
"CENTER" "CENTER2"
"CENTERX2" "DASHDOT"
"DASHDOT2" "DASHDOTX2"
)
) ; 下面程序将中心线图层加入一个列表
(setq ssguol2 (append
SSguol2
(TT-01 "ACAD_ISO04W100")
(TT-01 "ACAD_ISO08W100")
(TT-01 "CENTER")
(TT-01 "CENTER2")
(TT-01 "CENTERX2")
(TT-01 "DASHDOT")
(TT-01 "DASHDOT2")
(TT-01 "DASHDOTX2")
)
) ; 下面程序将选择集中随层的中心线加入一个列表
(SETQ i 0
PTzhongxinX '()
PTzhongxinY '()
)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ent1 (entget ent))
(if (or
(and
(member (cdr (assoc 8 ent1)) ssguol2)
(/= (cdr (assoc 0 ent1)) "INSERT")
(= (assoc 6 ent1) nil)
)
(member (cdr (assoc 6 ent1)) ssguol2)
)
(progn
(setq X1 (car (cdr (assoc 10 ent1)))
Y1 (cadr (cdr (assoc 10 ent1)))
X2 (car (cdr (assoc 11 ent1)))
Y2 (cadr (cdr (assoc 11 ent1)))
)
(if (= Y1 Y2)
(progn
(setq PTzhongxinX (cons (list X1 Y1 0.0) PTzhongxinX))
(setq PTzhongxinX (cons (list X2 Y2 0.0) PTzhongxinX))
)
)
(if (= X1 X2)
(progn
(setq PTzhongxinY (cons (list Y1 X1 0.0) PTzhongxinY))
(setq PTzhongxinY (cons (list Y2 X2 0.0) PTzhongxinY))
)
)
)
)
(SETQ i (+ 1 i))
)
(SETQ i 0)
(while (< i (length PTzhongxinY))
(if (member (nth i PTzhongxinY) yyy)
(SETQ yyy (vl-remove (nth i PTzhongxinY) yyy))
)
(SETQ i (+ 1 i))
)
yyy
)
;;; =================================================================
;;; 优化X坐标偏移
(defun TT-12 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
(setq X0 (car pt))
(setq Y0 (cadr pt))
(setq i 0
il 0
LSTZ '()
LSTY '()
)
(while (< i (length lsp))
(setq X (car (cdr (assoc 13 (entget (nth i lsp))))))
(if (<= X X0)
(setq LSTZ (cons (nth i lsp) LSTZ))
(setq LSTY (cons (nth i lsp) LSTY))
)
(SETQ i (+ 1 i))
)
(setq LSTZ LSTZ)
(setq LSTY (reverse LSTY))
(if (/= LSTZ '())
(progn
(setq i 0)
(setq X_LAST (car (cdr (assoc 13 (entget (nth 0 LSTZ))))))
(while (< i (length LSTZ))
(setq ent (nth i LSTZ))
(setq ent1 (entget ent))
(setq X (car (cdr (assoc 13 ent1))))
(setq X_LAST (min
X
X_LAST
)
)
(setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
(setq ent1 (subst
(cons 14 nP14)
(assoc 14 ent1)
ent1
)
)
(entmod ent1)
(SETQ i (+ 1 i))
(setq X_LAST (- X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
)
)
)
(if (/= LSTY '())
(progn
(setq i 0)
(setq X_LAST (+ X0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
(while (< i (length LSTY))
(setq ent (nth i LSTY))
(setq ent1 (entget ent))
(setq X (car (cdr (assoc 13 ent1))))
(setq X_LAST (max
X
X_LAST
)
)
(setq nP14 (list X_LAST (cadr (cdr (assoc 14 ent1))) 0.0))
(setq ent1 (subst
(cons 14 nP14)
(assoc 14 ent1)
ent1
)
)
(entmod ent1)
(SETQ i (+ 1 i))
(setq X_LAST (+ X_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
)
)
)
)
;;; =================================================================
;;; 优化Y坐标偏移
(defun TT-13 (lsp pt / ent ent1 i il lstl lsty lstz np14 x x_last x0 y0)
(setq X0 (car pt))
(setq Y0 (cadr pt))
(setq i 0
il 0
LSTX '()
LSTS '()
)
(while (< i (length lsp))
(setq Y (cadr (cdr (assoc 13 (entget (nth i lsp))))))
(if (<= Y Y0)
(setq LSTX (cons (nth i lsp) LSTX))
(setq LSTS (cons (nth i lsp) LSTS))
)
(SETQ i (+ 1 i))
)
(setq LSTX LSTX)
(setq LSTS (reverse LSTS))
(if (/= LSTX '())
(progn
(setq i 0)
(setq Y_LAST (cadr (cdr (assoc 13 (entget (nth 0 LSTX))))))
(while (< i (length LSTX))
(setq ent (nth i LSTX))
(setq ent1 (entget ent))
(setq Y (cadr (cdr (assoc 13 ent1))))
(setq Y_LAST (min
Y
Y_LAST
)
)
(setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
(setq ent1 (subst
(cons 14 nP14)
(assoc 14 ent1)
ent1
)
)
(entmod ent1)
(SETQ i (+ 1 i))
(setq Y_LAST (- Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
)
)
)
(if (/= LSTS '())
(progn
(setq i 0)
(setq Y_LAST (+ Y0 (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
(while (< i (length LSTS))
(setq ent (nth i LSTS))
(setq ent1 (entget ent))
(setq Y (cadr (cdr (assoc 13 ent1))))
(setq Y_LAST (max
Y
Y_LAST
)
)
(setq nP14 (list (car (cdr (assoc 14 ent1))) Y_LAST 0.0))
(setq ent1 (subst
(cons 14 nP14)
(assoc 14 ent1)
ent1
)
)
(entmod ent1)
(SETQ i (+ 1 i))
(setq Y_LAST (+ Y_LAST (* 1.5 (getvar "dimtxt") (getvar "dimscale"))))
)
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "undo" "be")
(setq orig_cmd(getvar "cmdecho"))
(setq orig_osm(getvar "osmode"))
(setq orig_orth(getvar "orthomode"))
(setq orig_lay(getvar "clayer"))
(setq diml_f(getvar "dimlfac"))
(setvar "errno" 0)
(setq olderr *error*)
(defun *error* (msg)
(setq en_er (getvar "errno"))
(setq errmsg (strcat "ERRNO = " (itoa en_er) "\nError: " msg))
(prompt errmsg)
(setq *error* olderr)
(command "undo" "e")
(command "undo" "")
(prompt "\n**")
(prin1)
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq cla(strcase orig_lay))
(prompt"\n匡璶夹猔Rà㎝Cà瓜じ :")
(if (setq ss(ssget))
(progn
(setq ss_n(sslength ss)
n 0
ssa(ssadd)
ssl(ssadd)
ssp(ssadd))
(repeat ss_n
(setq en(ssname ss n)
en_type(cdr(assoc 0 (entget en))))
(cond ((= "ARC" en_type)(ssadd en ssa))
((= "LINE" en_type) (ssadd en ssl))
((= "LWPOLYLINE" en_type) (ssadd en ssp))
)
(setq n(1+ n))
)
)
)
(if(> (setq ssp_n(sslength ssp)) 0)
(ex_pl)
)
(setq ssa_n(sslength ssa)
ssl_n(sslength ssl))
(if (> ssa_n 0)
(progn
(setq list_r '()
n 0)
(repeat ssa_n
(setq en(ssname ssa n)
en_r(cdr(assoc 40 (entget en))))
(if(= n 0)
(setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
(progn
(if(null (setq chk_r(member (rtos (* diml_f en_r) 2 3) list_r)))
(setq list_r(cons (rtos (* diml_f en_r) 2 3) list_r))
)
)
)
(setq n(1+ n))
)
(setq list_r_n(length list_r)
n 0)
(repeat list_r_n
(setq te_r(nth n list_r)
r_n 0
n1 0)
(repeat ssa_n
(setq en(ssname ssa n1)
en_r(cdr(assoc 40 (entget en))))
(if(= te_r (rtos (* diml_f en_r) 2 3))
(setq r_n(1+ r_n)
r_pt(cdr(assoc 10 (entget en))))
)
(setq n1(1+ n1))
)
(setq pt1(getpoint r_pt "\n翴匡ゅ癬翴 :")
pt0(polar r_pt (angle r_pt pt1) (/ (atof te_r) diml_f)))
(if(= "." (substr te_r 1 1))
(setq te1 "R0")
(setq te1 "R")
)
(if(= r_n 1)
(setq te(strcat te1 te_r))
(setq te(strcat (rtos r_n 2 0) "-" te1 te_r))
)
(if(> (car pt1) (car pt0))
(setq pt2(polar pt1 0 0.5))
(setq pt2(polar pt1 pi 0.5))
)
(command "leader" pt0 pt1 "" te "")
(setq n(1+ n))
)
)
)
(if(> ssl_n 0)
(progn
(setq ssc(ssadd)
list_c '()
n 0)
(repeat ssl_n
(setq en(ssname ssl n)
en_ps(cdr(assoc 10 (entget en)))
en_pe(cdr(assoc 11 (entget en)))
dx(abs(- (car en_ps) (car en_pe)))
dy(abs(- (cadr en_ps) (cadr en_pe))))
(if(equal dx dy 0.001)
(progn
(ssadd en ssc)
(if(null (setq chk_c(member (rtos (* diml_f dx) 2 1) list_c)))
(setq list_c(cons (rtos (* diml_f dx) 2 1) list_c))
)
)
)
(setq n(1+ n))
)
(if(> (setq list_c_n(length list_c)) 0)
(progn
(setq n 0)
(repeat list_c_n
(setq te_c(nth n list_c)
ssc_n(sslength ssc)
n1 0
c_n 0)
(repeat ssc_n
(setq en(ssname ssc n1)
en_ps(cdr(assoc 10 (entget en)))
en_pe(cdr(assoc 11 (entget en)))
dx(abs(- (car en_ps) (car en_pe)))
)
(if(= te_c (rtos (* diml_f dx) 2 1))
(setq c_n(1+ c_n)
c_pt(list (/ (+ (car en_ps) (car en_pe)) 2) (/ (+ (cadr en_ps) (cadr en_pe)) 2))
)
)
(setq n1(1+ n1))
)
(setq pt1(getpoint c_pt "\n翴匡ゅ癬翴 :"))
(if(= "." (substr te_c 1 1))
(setq te1 "C0")
(setq te1 "C")
)
(if(= c_n 1)
(setq te(strcat te1 te_c))
(setq te(strcat (rtos c_n 2 0) "-" te1 te_c))
)
(if(> (car pt1) (car c_pt))
(setq pt2(polar pt1 0 0.5))
(setq pt2(polar pt1 pi 0.5))
)
(command "leader" c_pt pt1 "" te "")
(setq n(1+ n))
)
)
)
)
)
(if sst
(command "erase" sst "")
)
(setq *error* olderr)
(command "undo" "e")
(setvar "cmdecho" orig_cmd)
(setvar "osmode" orig_osm)
(setvar "orthomode" orig_orth)
(setvar "clayer" orig_lay)
(prin1)
)
;;;(ex_pl)
(defun ex_pl(/ sst_n en en_type n)
(command "-layer" "m" "temp-user" "c" "47" "temp-user" "lt" "hidden" "temp-user" "")
(command "copy" ssp "" (list 0 0) (list 0 0))
(command "change" ssp "" "p" "la" "temp-user" "")
(command "explode" ssp)
(setq sst(ssget "x" '((8 . "TEMP-USER"))))
(setq sst_n(sslength sst)
n 0)
(repeat sst_n
(setq en(ssname sst n)
en_type(cdr(assoc 0 (entget en))))
(cond((= "ARC" en_type) (ssadd en ssa))
((= "LINE" en_type) (ssadd en ssl))
)
(setq n(1+ n))
)
(setvar "clayer" orig_lay)
(prin1)
)
(princ "\n*** 欢迎使用冲模设计软件,快捷功能已成功加载 *** <><><><> ***");(setq t tt)) 耐心等待
不知道是不是改变小数点的位数，如果是，第528和559行中第二个“2”，就是控制小数点的位数 不是这个问题，是标注出来的数是两位小数，多少有些我要手动改一位小数，有些要改三位小数的，可以改不了，不知道为什么。正常手工标的数是可以随意改的 我也在等待…………………… 高手都冷得躲被窝了，竟然没有人指点一下
页:
[1]