|
(defun c:ccs (/ sym ssy sc snum systr scstr txtpnt numstr n cnt i txtlst oldtxt oldlay ent scpnt diment dimn measur
newtxt prec dimtyp
)
(setvar "cmdecho" 0)
(grtext -1 "該程序是用以將剖視圖(或放大圖)的尺寸自動從默認值變成實測值,再放大它並插入標示.")
(setq ssy (getstring "\nThe section symbol is:"))
(setq systr nil
scstr nil
numstr nil
) ;_ 結束setq
;;If no section symbol,then just make the measurement of the dimension.
(IF (/= ssy "")
(progn
;;(initget 128 "Detail Section")
(setq sym (getstring "\n是剖視圖還是放大圖?Detail/<Section>:"))
(if (or (= sym "") (= sym "s")) ;presume it as section view
(setq systr (strcat "SECTION " ssy "-" ssy)
systr (strcase systr) ;|insure the input cha. is uppercase.|;
) ;_ 結束setq
(setq systr (strcat "DETAIL " ssy)
systr (strcase systr)
) ;_ 結束setq
) ;_ 結束if
(setq sc (getstring "\nThe section scale?(needed to be integers)"))
;| access the number of places to be scaled.|;
(setq snum (getstring "\nHow many places?(needed to be integers)"))
(if (> (atoi snum) 1)
(setq numstr (strcat snum "PLS")
numstr (strcase numstr)
) ;_ 結束setq
) ;_if just 1 place,not display it.
) ;_ 結束progn
) ;_ 結束IF
(grtext -1 "Please select the dimension object...")
(setq ent (ssget))
(setq diment (ssget "p" '((0 . "dimension")))
n (sslength diment)
) ;_ 結束setq
(princ (strcat "\n*** Total " (itoa n) " dimensions to be selected. ***"))
(setq cnt 0
i 0
) ;_reset countor and list NO.
(while (PROGN (grtext -1 "OK.Modifying the dimension...")
(< i n)
) ;逐一搜索標注實體.
(setq dimn (entget (ssname diment i))) ;取得實體.
;;;->(setq dimn (entget (car (entsel)))) ;取得實體數據表.
(setq oldtxt (cdr (assoc 1 dimn))
dimtyp (cdr (assoc 100 (reverse dimn)))
) ;_ 結束setq
(if (and (or (wcmatch oldtxt "*<>*") (= oldtxt ""))
(wcmatch dimtyp "~*Angular*")
) ;_ 結束and
;|只有是非角度尺寸,才用實測值代替默認值. |;
(progn
(setq measur (C42 dimn) ;|***調用函數c42(ent).|;
prec (getvar "dimdec")
measur (rtos measur 2 prec) ;|將測量值從實數變成字串|;
) ;_ 結束setq
(cond ((wcmatch dimtyp "*Diametric*") (setq measur (strcat "%%c" measur)))
; _若是直徑,則在數字前加直徑符號"%%c"
((wcmatch dimtyp "*Radial*") (setq measur (strcat "R" measur))) ;_若是半徑,則在數字前加半徑符號R.
) ;_ 結束cond
(if (wcmatch oldtxt "*<>*")
(setq newtxt (subst_str measur "<>" oldtxt)) ;|只替代默認值部分.***調用函數subst_str(newstr oldstr str)|;
(setq newtxt measur)
) ;_ 結束if
(setq dimn (subst (cons 1 newtxt) (cons 1 oldtxt) dimn))
(entmod dimn)
(setq cnt (1+ cnt))
) ;_ 結束progn
) ;_ 結束if
(setq i (1+ i)) ;search the next dimension.
) ;_ 結束while
(princ (strcat "\n*** Just " (itoa cnt) " dimensions modified! ***"))
;;if the scale is 1:1,not to scale it.
(if (/= sc "")
(if (> (atoi sc) 1)
(progn (setq scpnt (getpoint "\nInput the scale center point:"))
(command "._scale" ent "" scpnt (atof sc))
(setq scstr (strcat "SCALE " sc ":1") ;_ if it's 1:1(no input),not to display it
scstr (strcase scstr)
) ;_ 結束setq
) ;_ 結束progn
) ;_ 結束if
) ;_ 結束IF
(if (or systr scstr numstr)
(progn
(setq txtpnt (getpoint "\nWhere to place the note?"))
(setq oldlay (getvar "clayer"))
(if (tblsearch "layer" "mark")
(setvar "clayer" "mark")
) ;_ 結束IF
(command "._text" "s" "standard" "j" "mc" txtpnt (* 2.5 (getvar "dimscale")) "0" systr "")
(if scstr
(command "._text" "" scstr)
) ;_ 結束if
(if numstr
(command "._text" "" numstr)
) ;_ 結束if
;(command)
(setvar "clayer" oldlay)
) ;_ 結束PROGN
) ;_ 結束IF
(setvar "cmdecho" 1)
(grtext)
(princ)
) ;_ 結束defun
;;;---------SUBPROGRAMM---------------
;;;This pro. is to make the linear dimension's measurement.
(defun c42 (ent / p1x p1y p2x p2y dy v ang dimtyp dx p1 p2 dimtyp)
(setq dimtyp (cdr (assoc 70 ent))
dimtyp (logand dimtyp 7)
) ;_ 結束setq
(cond
;;aligned&rotateddimension
((= dimtyp 0)
(progn
(setq p1 (assoc 13 ent)
p2 (assoc 14 ent)
p1x (nth 1 p1)
p1y (nth 2 p1)
p2x (nth 1 p2)
p2y (nth 2 p2)
dx (abs (- p1x p2x))
dy (abs (- p1y p2y))
ang (cdr (assoc 50 ent))
) ;_ 結束setq
(if (= ang 0)
(setq v dx)
(setq v dy)
) ;_ 結束if
) ;_ 結束progn
) ;_case 1
;;aligneddimension
((= dimtyp 1)
(setq p1 (assoc 13 ent)
p2 (assoc 14 ent)
v (distance (cdr p1) (cdr p2))
) ;_ 結束setq
) ;_case 2
;;radialdimension & diametricdimension
((or (= dimtyp 4) (= dimtyp 3))
(setq p1 (assoc 10 ent)
p2 (assoc 15 ent)
v (distance (cdr p1) (cdr p2)) ;取得數值v作為函數值.
) ;_ 結束setq
) ;_case 3
) ;_ 結束cond
) ;_ 結束defun
;;;;-SUBROTINE 2------
;;;This pro. is to substitute a new string for the old string in the source string.
(defun subst_str (newstr oldstr str / i k k1 k2 n tmpstr stre strf)
(setq k1 (strlen str)
k2 (strlen oldstr)
k (1+ (- k1 k2))
i 1
n nil
) ;_ 結束setq
(while (<= i k)
(setq tmpstr (substr str i k2))
(if (= tmpstr oldstr)
(progn
(setq n i
i (1+ k)
) ;set the loop-off condition to end the loop
) ;_ 結束progn
(setq i (1+ i))
) ;_ 結束if
) ;_ 結束while
(setq k1 (1- n)
k2 (+ k2 n)
strf (substr str 1 k1)
stre (substr str k2)
) ;_ 結束setq
(setq str (strcat strf newstr stre))
) ;_ 結束defun
;;;~~~~~~~~~~end of CCS~~~~~~~~~~~~ | 
[复制链接]
发表于 2010-6-5 06:32:00
置顶卡
变色卡
显身卡
楼主