明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 14615|回复: 27

这个是我最近做的一个修改尺寸文本的源代码。

  [复制链接]
发表于 2002-10-17 12:06 | 显示全部楼层 |阅读模式
(defun clerr (s)
    (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
    )
    (setvar "DIMSCALE" dims)
    (setvar "CMDECHO"  scmde)
    (setq *error*  olderr)
    (princ)
    )
;发生ESC H或者CTOL_C的中断处理

   (defun C:bzxg()
   (setq olderr *error*
         *error* clerr)
   (setq scmde (getvar "CMDECHO" ))
   (setq dims (getvar "DIMSCALE"))
    (setvar "cmdecho" 0)
    (while (/= (getvar "cmdecho") 0)
    (setvar "cmdecho" 0)
    )
    (princ "\n尺寸修改(zhaoy 2002/10/14)")
    (setq contr 1)
    (while (= contr 1);循环操作用法
     ;ENTSEL 函数
    (setq obj (car (entsel "\n请选择需要修改的标注线")))
    (setq obj_temp obj)
    (if (/= obj nil)
    (progn
    ;ENTGET函数
    (setq obj (entget obj))
    ;ASSOC函数
    (if (= (cdr (assoc 0 obj)) "DIMENSION") (setq contr 0))
    ))
     )

   (setq tstyle (car (list (cdr (assoc 3 obj)))))
   (if (= (substr tstyle 1 5) "STAND")
   (progn
      (setq obj (subst (cons 3 "STANDARD") (assoc 3 obj) obj))
      (entmod obj)
      )
    )
   (setq txt (cdr (assoc 1 obj))
        p1 (cdr (assoc 10 obj))
        p2 (cdr (assoc 14 obj))
        p3 (cdr (assoc 13 obj)))
   ;dimdec系统变量
   (setq tt (getvar "dimdec"));tt为尺寸精度
   (if (= txt "")
   (progn
    ;getword函数用法
    (initget "Yes  No")
    (setq kw (getkword "\n不使用原尺寸(N)/<使用原尺寸(Y)>:"))
   (COND
    ((= KW "No")
    (setq txt_y (getreal "\n输入标注尺寸值:" ))
    )
    (t
    (setq p2 (inters p2 p1 p3 (polar p3 (+ (angle p2 p1) (/ pi 2.0)) 10) nil))
    (setq txt (distance p2 p3));取得尺寸值
    (setq txt_y txt)
    )
    ))
   
   (progn
   (princ "\n此标注已经被修改过,程序不敢确认是正确的,要求您重新输入:" )
   (setq txt_y (getreal "\n输入标注尺寸值:" ))
   ))
   
   ;;以上为选择要修改的尺寸并把尺寸值进行精确的计算
   (setq z_txt (rtos txt_y 2 tt))
   (setq jiej (getreal "\n输入节距:"))
   (setq gshu(/ txt_y jiej))
   (setq gshu  (rtos gshu 2 ))
   (setq jiej  (rtos jiej 2 1)) ;转化为字符串
   (setq txtf (strcat  gshu  "×"  jiej "=" z_txt))
   ;entmode函数使用
   (setq ed (entget obj_temp))
   (setq ed (subst (cons 1 txtf) (assoc 1 ed) ed))
   (entmod ed)
   (setvar "DIMSCALE" dims)
   (setvar "CMDECHO"  scmde)
   (setq *error*  olderr)
   (princ)
   )
此程序对您可能没多大的用处,我认为里面包含了几个很常用的函数的用法。如果有好的建议可以提出来,大家来帮我把它维护的更好,谢谢了。

点评

谢谢分享  发表于 2012-3-15 19:31
发表于 2004-5-4 12:24 | 显示全部楼层
;;如尺寸值與文本一致,則文本不變色,否則文本被修改但顏色
;;變如紅色,這樣用戶對這個功能會更好理解也容易維護。
;;BY LUCAS
(defun C:TT (/ SS N VOBJ)
(setq SS (ssget "X" '((0 . "DIMENSION")))
N 0
)
(repeat (sslength SS)
(setq VOBJ (vlax-ename->vla-object (ssname SS N)))
(if (and VOBJ
(vlax-read-enabled-p VOBJ)
(not (wcmatch (vla-get-textoverride VOBJ) "*<>*,"))
(vlax-write-enabled-p VOBJ)
)
(vla-put-textcolor VOBJ 1)
)
(setq N (1+ N))
)
(princ)
)
发表于 2019-9-20 16:19 | 显示全部楼层
非常棒的程序代码,很好的资料,谢谢楼主分享的资料。
发表于 2019-9-19 09:50 | 显示全部楼层
很实用的程序,多谢大家的分享
发表于 2002-12-8 12:19 | 显示全部楼层

1

(defun B_TOLERANCE_READ_TXT;读出尺寸的大小
  (
  /
  B_dim_name;和所选尺寸相对应的块名
  B_dim_txt;尺寸文本(CHR)
  B_dim_sset;和所选尺寸相对应的块的子实体名
  B_dim_length;尺寸文本的长度
  B_dim_txt_str;中间字符串变量
  B_dim_txt_no;中间计数变量
  B_dim_txt_chr;中间字符变量
  )
  (if (/= (cdr (assoc 0 B_dim_ent)) "DIMENSION")
    (progn
      (prompt "\n这不是个尺寸标注")
      (setq B_dim_choose -1)
    );end-progn当不是尺寸标注时由B_dim_choose判断
    (progn
      (setq B_dim_or (cdr (assoc 1 B_dim_ent)));当是自动生成的尺寸文本时为空
      (setq B_dim_name (cdr (assoc 2 B_dim_ent)));读出同名的块名
      (setq B_dim_sset (cdr (assoc -2 (tblsearch "BLOCK" B_dim_name))));找块的实体名
        (while (/= (cdr (assoc 0 (entget B_dim_sset))) "MTEXT")
        (setq B_dim_sset (entnext B_dim_sset))
      );end-while寻找写有尺寸大小文本的子实体
      (setq B_dim_txt (cdr (assoc 1 (entget B_dim_sset))));读出尺寸大小文本
      (setq B_dim_height (cdr (assoc 40 (entget B_dim_sset))))
      (setq B_dim_length (strlen B_dim_txt));读出尺寸大小文本的长度
      (if (= (substr B_dim_txt 4 1) ";")
        (progn
          (setq B_dim_length (- B_dim_length 4))
          (setq B_dim_txt (substr B_dim_txt 5 B_dim_length))
        );end-progn
      );end-if去掉读出的尺寸文本的前缀
      (cond
        ((= (substr B_dim_txt 1 1) "r")
          (setq B_dim_length (- B_dim_length 1))
          (setq B_dim_txt (substr B_dim_txt 2 B_dim_length))
        );end-1
        ((= (substr B_dim_txt 1 1) "R")
          (setq B_dim_length (- B_dim_length 1))
          (setq B_dim_txt (substr B_dim_txt 2 B_dim_length))
        );end-1
        ((= (substr B_dim_txt 1 1) "m")
          (setq B_dim_length (- B_dim_length 1))
          (setq B_dim_txt (substr B_dim_txt 2 B_dim_length))
        );end-1
        ((= (substr B_dim_txt 1 1) "M")
          (setq B_dim_length (- B_dim_length 1))
          (setq B_dim_txt (substr B_dim_txt 2 B_dim_length))
        );end-1
        ((= (substr B_dim_txt 2 6) "U+2205")
          (setq B_dim_length (- B_dim_length 7))
          (setq B_dim_txt (substr B_dim_txt 8 B_dim_length))
        );end-1
      );end-cond
      (setq B_dim_txt_str "")
      (setq B_dim_txt_no B_dim_length)
      (while (> B_dim_txt_no 0)
        (setq B_dim_txt_no (1- B_dim_txt_no))
        (setq B_dim_txt_chr (substr B_dim_txt (- B_dim_length B_dim_txt_no) 1))
        (if (/= B_dim_txt_chr ",")
          (setq B_dim_txt_str (strcat B_dim_txt_str B_dim_txt_chr))  
        );end-if
      );end-while
      (setq B_dim_txt B_dim_txt_str);去掉尺寸文本里的","
      (setq B_dim_size (atof B_dim_txt))
      (if (> B_dim_size 3150.0)
        (progn
          (if (null B_ERROR) (load "B_ERROR"))
          (B_ERROR "超出程序设计范围,本程序无法计算,请查标准公差手册标注")
          (setq B_dim_choose -2)
        );end-progn
      );end-if
    );end-progn
  );end-if
);B_TOLERANCE_READ_TXT
大家看看
发表于 2002-12-22 13:41 | 显示全部楼层

来看看,这是我写的,是不是更简单一些呢?

(setq txt1 "3000")
(defun editdim ()
   (princ "\n选择需修改的标注 :")
   (setq p (ssget))
   (command "dimedit" "n" dim2 "p" "")
   (setvar "cmdecho" 1)
)
(defun editdimh ()
   (princ "\n选择需修改的标注 :")
   (setq p (ssget))
   (command "dimedit" "h" "p" "")
   (setvar "cmdecho" 1)
)
(defun c:de (/ dim1 p dim2)
(setvar "cmdecho" 0)
(princ "\n请输入标注字符,允许汉字和空格。(空格->还原)(空回车->缺省值)<")
(princ txt1)
(setq dim1 (getstring T ">:"))
(cond
      ((= dim1 " ")(editdim))
      ((= dim1 "")(setq dim2 txt1)(editdim))
      ((= dim1 "H")(editdimh))
      ((setq txt1 dim1)(setq dim2 dim1)(editdim))
  )   

)
发表于 2003-10-15 13:37 | 显示全部楼层
leeyeafu的程序怎么用啊?
发表于 2003-10-19 04:31 | 显示全部楼层
如果多的无用注释,如:
 ;ENTSEL函数
 ;ASSOC函数

没有必要的语句
    (setvar "cmdecho" 0)
    (while (/= (getvar "cmdecho") 0) (setvar "cmdecho" 0))

全部使用全局变量

....

努力,再努力。
发表于 2004-4-12 00:10 | 显示全部楼层
有用vba写的么
发表于 2004-4-27 17:07 | 显示全部楼层
如尺寸值与文本一致,则文本不变色,否则文本被修改但颜色变如红色,这样用户对这个功能会更好理解也容易维护。
发表于 2004-5-3 04:00 | 显示全部楼层
楼上这个提法有点意思
发表于 2004-9-2 15:50 | 显示全部楼层
一个正命令:如尺寸值与文本一致,则文本不变色,否则文本被修改但颜色变如红色,并报改了的和不改的统计数据,这样用户对这个功能会更好理解也容易维护。


另一个反命令:当需要改文本为尺寸值,如文本与尺寸值一致,则改过来,否则文本不被修改但颜色变如黄色,并报改了的和不改的统计数据。


有没有R14下的lisp反命令。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 19:38 , Processed in 0.191986 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表