TrueTable(破解) .

429014673 发表于 2010-6-5 06:32:00

本帖最后由 429014673 于 2021-4-12 11:12 编辑

彳余发表于 2021-6-10 16:56:12

TrueTable(破解),niubi

＿Levin 发表于 2021-3-26 21:09:05

威武霸气。。牛逼啊

tender138 发表于 2020-5-27 17:30:01

威武霸气,牛逼啊

429014673 发表于 2010-6-5 06:57:00

本帖最后由作者于 2010-6-5 7:24:38 编辑 (defun c:q2()       (setq var1 (getvar "osmode")      var2 (getvar "dimassoc" ))       (setvar "cmdecho" 0 )(setvar "osmode" 0)(setvar "dimassoc" 2)            di (getreal":\nInput The Distance Between The Object And Dimension Line...")             n (1- (sslength sg))      )        (while (setq  sn (ssname sg n)        ent (entget sn)        )         (cond ((=  (cdr(assoc 0 ent)) "LINE") (diml))        ((=  (cdr(assoc 0 ent)) "ARC" ) (progn(dimr)(dimarc)))        ((=  (cdr(assoc 0 ent)) "POLYLINE" ) (dimsp sn di))        )   (setq n (1- n))   )      .........

429014673 发表于 2010-6-5 07:03:00

本帖最后由作者于 2010-6-5 7:24:15 编辑 再放一条
查找手動修改過的尺寸(RF)
 ;-----------------------------------------------------------------  (defun c:RF ( )    ;Real Find,用于查找客戶原圖中手動修改過的尺寸   (COMMAND "UCS" "W")   (princ "查找手動修改過的尺寸")   (SETQ COUNTOR 0)   (SETQ DIMSTRING "here")   (PROMPT "\n指示查找區域(確認對象不是一個塊!):")   (SETVAR "OSMODE" 0)(SETVAR "ORTHOMODE" 0)   (SETQ ENTGRP (SSGET))   (SETQ COUNT 0)                                            .........

429014673 发表于 2010-6-5 07:04:00

剖視&放大(CCS)
--------------------------------------------------------------
(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...")
 ((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))
 i1
 nnil
) ;_ 結束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

............

429014673 发表于 2010-6-5 07:05:00

本帖最后由作者于 2010-6-5 7:25:35 编辑 圖元縮放,尺寸不變(RS) ;-----------------------------------------------------------------  (defun c:RS ( )               ;Real Scale,用于畫剖視圖縮放圖元時,維持標注尺寸不變   (princ "圖元縮放,尺寸不變")   (PROMPT "\n指示縮放區域:")   (SETVAR "OSMODE" 0)(SETVAR "ORTHOMODE" 0)   (setq scale (ssget ))   (SETQ ENTGRP scale)   (SETQ COUNT 0)                                           (REPEAT (SSLENGTH ENTGRP)     (SETQ ENTNAME (SSNAME ENTGRP COUNT))     (SETQ ENT (ENTGET ENTNAME))     (IF (AND (= (CDR (ASSOC 0 ENT)) "DIMENSION")                     (/= (cdr (ASSOC 1 ENT)) ""))            (PROGN (PRINC "\n對象中不能有修改過的尺寸!") (EXIT)))        (IF (and(= (CDR (ASSOC 0 ENT)) "DIMENSION")                ;AlignedDimension             (= (cdr (nth 19 ent)) "AcDbAlignedDimension"))                 (PROGN               (setq P1 (assoc 13 ENT))               (setq P2 (assoc 14 ENT))               (setq P1x (nth 1 P1))                (setq P1y (nth 2 P1))                                 (setq P2x (nth 1 P2))               (setq P2y (nth 2 P2))               (setq DX (ABS(- P1x P2x)))                         (setq DY (ABS(- P1y P2y)))                          (setq SS (assoc 10 ENT))               (setq TT (assoc 11 ENT))               (setq SSx (nth 1 SS))                (setq TTx (nth 1 TT))               (setq SSy (nth 2 SS))                (setq TTy (nth 2 TT))                  (IF (= SSx TTx)                                     (setq V Dy))               (IF (and(/= SSx TTx)(= SSy TTy))                  (setq V Dx))                                      ;取得數值V1               (IF (and(/= SSx TTx)(/= SSy TTy))                  (setq V (distance (cdr p1) (cdr p2))))                            (SETQ W (rtos V 2 2))               (SETQ ENT (SUBST (CONS 1 W) (ASSOC 1 ENT) ENT))       ;MODIFY               (ENTMOD ENT)                                          ;UPDATE           )       )     (IF (and(= (CDR (ASSOC 0 ENT)) "DIMENSION")                    ;RadialDimension             (= (cdr (nth 19 ent)) "AcDbRadialDimension"))           (PROGN               (setq P1 (assoc 10 ENT))               (setq P2 (assoc 15 ENT))               (setq V (distance (cdr p1) (cdr p2)))                ;取得數值V1                          (SETQ W (strcat "R" (rtos V 2 2)))               (SETQ ENT (SUBST (CONS 1 W) (ASSOC 1 ENT) ENT))       ;MODIFY               (ENTMOD ENT)                                          ;UPDATE           )       )   (SETQ COUNT (1+ COUNT)) ..........

429014673 发表于 2010-6-5 07:06:00

..........

429014673 发表于 2010-6-5 07:28:00

429014673 发表于 2010-6-5 07:56:00

标注弧长、半径、线段
(defun c:q2()       (setq var1 (getvar "osmode")      var2 (getvar "dimassoc" ))       (setvar "cmdecho" 0 )(setvar "osmode" 0)(setvar "dimassoc" 2)       (princ "\nChoose Objects You Want To Auto Make Dimensions...")       (setq sg (ssget)      di (getreal":\nInput The Distance Between The Object And Dimension Line...")             n (1- (sslength sg))      )        (while (setq  sn (ssname sg n)        ent (entget sn)        )         (cond ((=  (cdr(assoc 0 ent)) "LINE") (diml))        ((=  (cdr(assoc 0 ent)) "ARC" ) (progn(dimr)(dimarc)))        ((=  (cdr(assoc 0 ent)) "POLYLINE" ) (dimsp sn di))        )   (setq n (1- n))   )         (command)         (setvar "cmdecho" 1)         (setvar "dimassoc" var2 )         (setvar "osmode" var1)         (princ"\nByoend Ever You Thinking...")   )

429014673 发表于 2010-6-5 08:02:00

(defun c:RF ( )    ;Real Find,用于查找客戶原圖中手動修改過的尺寸   (COMMAND "UCS" "W")   (princ "查找手動修改過的尺寸")   (SETQ COUNTOR 0)   (SETQ DIMSTRING "here")   (PROMPT "\n指示查找區域(確認對象不是一個塊!):")   (SETVAR "OSMODE" 0)(SETVAR "ORTHOMODE" 0)   (SETQ ENTGRP (SSGET))   (SETQ COUNT 0)                                           (REPEAT (SSLENGTH ENTGRP)     (SETQ ENTNAME (SSNAME ENTGRP COUNT))     (SETQ ENT (ENTGET ENTNAME))     (IF (AND (= (CDR (ASSOC 0 ENT)) "DIMENSION")                     (/= (cdr (ASSOC 1 ENT)) ""))                    (PROGN         (SETQ TXTPT (CDR (ASSOC 11 ENT)))                         (SETQ OLDLAYER (GETVAR "CLAYER"))         (COMMAND "-LAYER" "S" "MARK" "")                       (COMMAND "_.TEXT" "J" "C" TXTPT (* 5.0 (GETVAR "DIMSCALE")) "" (strcase DIMSTRING t))         (COMMAND "-LAYER" "S" OLDLAYER "")         (SETQ COUNTOR (1+ COUNTOR))                          )     )     (SETQ COUNT (1+ COUNT))   )   (COMMAND "_UCS" "P")   (PRINC "\n OK! 找到 ")(PRINC COUNTOR) (PRINC " 個手動修改過的尺寸!")   (PRINC) )

429014673 发表于 2010-6-5 08:03:00

(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...")                  (          )                                                 ;逐一搜索標注實體.       (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~~~~~~~~~~~~

页: [1] 2 3 4 5 6 7 8 9 10

明经CAD社区's Archiver

TrueTable(破解) .