求文字格式刷lsp程序

hao3ren · 发表于 2012-10-31 10:24:09

(defun c:qm 一般C:后面的就是执行命令，另外我觉得没什么必要啊，cad自身的格式刷可以输入S进行设置

自贡黄明儒 · 发表于 2012-12-19 08:40:24

本帖最后由自贡黄明儒于 2012-12-19 11:51 编辑

;;发现本论坛一个格式刷，看看是不是你需要的

;;本程序是类似于R14应用程序中经常用的格式刷的功能
(defun c:ddbrush (/ #SPIN AA BJ BLK C CC DCLID EE
F FN FNAME ID JT JZXZ LEN LENG LIN
MC MONAME MOTHER MX MXX MY MYY
N NAME NN1 NN2 NN3 NN4 OK PT3 QX
RATE SCJD SF SS SSS STANDARD STR TC
TNAME TT1 TT2 TT3 TT4 TTT1 TTT2 TTT3 TTT4
TX TXX TY TYY WZLX WZNR XX XXBL YC
YESNO ZG ZTJD ZXBL
)
(defun spin (wh)
(prompt (strcat "\r "
wh
(cond ((= #spin "|") (setq #spin "/"))
((= #spin "/") (setq #spin "-"))
((= #spin "-") (setq #spin "\\"))
(T (setq #spin "|"))
)
)
)
(princ)
)
(defun modim (/ exmo exmo3 exch)
(setq exmo (entget (car sss) '("ACAD")))
(setq exmo3 (assoc -3 exmo))
(setq exch (entget ee '("ACAD")))
(princ "\nsecond\n\n")
(princ exch)
(princ "\n\n first\n")
(princ exmo3)
(if (not (or (NULL (assoc -3 exch)) (NULL exmo3)))
(setq exch (subst exmo3 (assoc -3 exch) exch))
)
(if (NULL (assoc -3 exch))
(setq exch (append exch (list exmo3)))
)
(if (NULL exmo3)
(setq exch (subst standard (assoc -3 exch) exch))
)
(princ "\n\nstart newsecond\n")
(princ exch)
(princ "\n\nend\n")
(entmod exch)
)
(defun myreplace (attrib / variey1 variey2 variety xxxx yyyy)
(if (NULL variey1)
(setq variey1 (assoc attrib aa))
)
(setq variey2 (cdr (assoc attrib mother)))
(if (NULL variey2)
(setq variey2 (assoc attrib mother))
)
(if (and (not (null variey1)) (not (null variey2)))
(progn (setq aa
(subst (cons attrib variey2) (assoc attrib aa) aa)
)
(entmod aa)
)
)
(if (and (null variey1) (not (null variey2)))
(setq aa (append aa (list (assoc attrib mother))))
)
;;以下，母没有子有，即母属性随层，但子属性不随层,分三种情况。。。。。(不知何故cond总是有问题，故用三个if的拙法完
(if (= scjd 1)
(setq xxxx mxx
yyyy myy
)
(setq xxxx "BYLAYER"
yyyy 256
)
) ;用于色层绝对
(if (and (not (null variey1)) (null variey2) (= attrib 6))
(setq aa (subst (cons attrib xxxx) (assoc attrib aa) aa))
) ;线型
(if (and (not (null variey1)) (null variey2) (= attrib 62))
(setq aa (subst (cons attrib yyyy) (assoc attrib aa) aa))
) ;颜色,注：随层为256;随块为0
;;以下是母子都没有的情况
(if (and (null variey1) (null variey2) (= attrib 6))
(setq aa (append aa (list (cons attrib xxxx))))
)
(if (and (null variey1) (null variey2) (= attrib 62))
(setq aa (append aa (list (cons attrib yyyy))))
)
(if (and (not (null variey1)) (null variey2) (= attrib 48))
(progn (setq aa (subst (cons attrib 1) (assoc attrib aa) aa))
(princ "ok")
(princ aa)
)
) ;线型比例
(entmod aa)
)
(defun mysol (/ ll pt0 pt1) ;该函数用于修改箭头的大小
(setq ll (distance (cdr (assoc 10 mother)) (cdr (assoc 13 mother))))
(setq pt0 (cdr (assoc 10 aa))
pt1 (cdr (assoc 11 aa))
pt3 (cdr (assoc 13 aa))
)
(setq rate (/ ll (distance pt0 pt3)))
(setq pt0 (snpt pt3 pt0 rate)
pt1 (snpt pt3 pt1 rate)
)
(setq aa
(subst (cons 10 pt0) (assoc 10 aa) aa)
)
(setq aa
(subst (cons 11 pt1) (assoc 11 aa) aa)
)
(entmod aa)
)
(defun snpt (p1 p2 rate / sx1 sx2 sx3 sy1 sy2 sy3)
(setq sx1 (car p1)
sy1 (cadr p1)
sx2 (car p2)
sy2 (cadr p2)
)
(setq sx3 (+ (* rate (- sx2 sx1)) sx1))
(setq sy3 (+ (* rate (- sy2 sy1)) sy1))
(list sx3 sy3 0.0)
)
(defun do_set ()
(setq sf (atoi (get_tile "sf")))
(setq jzxz (atoi (get_tile "jzxz")))
(if (= sf 1)
(setq n 1)
(setq n 0)
)
(setq xx (+ (atoi (get_tile "xx")) n))
(setq xxbl (+ (atoi (get_tile "xxbl")) n))
(setq yc (+ (atoi (get_tile "yc")) n))
(setq wzlx (+ (atoi (get_tile "wzlx")) n))
(setq zg (+ (atoi (get_tile "zg")) n))
(setq zxbl (+ (atoi (get_tile "zxbl")) n))
(setq wznr (+ (atoi (get_tile "wznr")) n))
(setq cc (+ (atoi (get_tile "cc")) n))
(setq c (+ (atoi (get_tile "c")) n))
(setq jt (+ (atoi (get_tile "jt")) n))
(setq ztjd (+ (atoi (get_tile "ztjd")) n))
(setq bj (+ (atoi (get_tile "bj")) n))
(setq scjd (+ (atoi (get_tile "scjd")) n))
(setq tt1 (atoi (get_tile "tt1")))
(setq tt2 (atoi (get_tile "tt2")))
(setq tt3 (atoi (get_tile "tt3")))
(setq tt4 (atoi (get_tile "tt4")))
(setq qx (atoi (get_tile "qx")))
(setq ok 1)
)
(defun init ()
(set_tile "jzxz" (itoa jzxz))
(if (= sf 1)
(setq n 1)
(setq n 0)
)
(set_tile "sf" (itoa sf))
(set_tile "xx" (itoa (- xx n)))
(set_tile "xxbl" (itoa (- xxbl n)))
(set_tile "yc" (itoa (- yc n)))
(set_tile "wzlx" (itoa (- wzlx n)))
(set_tile "zg" (itoa (- zg n)))
(set_tile "zxbl" (itoa (- zxbl n)))
(set_tile "wznr" (itoa (- wznr n)))
(set_tile "cc" (itoa (- cc n)))
(set_tile "c" (itoa (- c n)))
(set_tile "jt" (itoa (- jt n)))
(set_tile "ztjd" (itoa (- ztjd n)))
(set_tile "bj" (itoa (- bj n)))
(set_tile "scjd" (itoa (- scjd n)))
(set_tile "qx" (itoa qx))
)
(defun initl ()
(setq nn1 '()
nn2 '()
nn3 '()
nn4 '("LINE" "PLINE" "CIRCLE" "ARC"
"TEXT" "MTEXT" "ATTDEF" "DIMENSION"
"INSERT" "SOLID"
)
n 0
)
(start_list "tt1" 3)
(add_list "过滤层(不过滤)")
(setq blk (tblnext "LAYER" 1))
(while (not (NULL blk))
(setq n (1+ n))
(setq tname (cdr (nth 1 blk)))
(setq nn1
(append nn1
(list (list tname (cdr (nth 3 blk)) (cdr (nth 4 blk))))
)
)
(add_list tname)
(setq blk (tblnext "LAYER" NIL))
)
(end_list)
(start_list "tt2" 3)
(add_list "过滤线型(不过滤)")
(setq blk (tblnext "LTYPE" 1))
(while (not (NULL blk))
(setq tname (cdr (nth 1 blk)))
(setq nn2 (append nn2 (list tname)))
(add_list tname)
(setq blk (tblnext "LTYPE" NIL))
)
(end_list)
(start_list "tt3" 3)
(add_list "过滤颜色(不过滤)")
(setq n 0)
(repeat 255
(setq n (1+ n))
(add_list (itoa n))
)
(end_list)
(start_list "tt4" 3)
(add_list "过滤实体(不过滤)")
(setq n 0)
(setq len (length nn4))
(repeat len
(add_list (nth n nn4))
(setq n (1+ n))
)
(end_list)
)
(defun ok_do ()
(print "请选择要修改的实体")
(if (= qx 1)
(setq ss (ssget "x"))
(setq ss (ssget))
)
(setq leng (sslength ss)
n 0
str ""
)
(repeat leng
(spin "请您耐心等待，程序正在处理......")
(setq ee (ssname ss n))
(setq aa (entget ee))
(setq name (cdr (assoc 0 aa)))
(setq yesno f)
(if (and (= tt1 0) (= tt2 0) (= tt3 0) (= tt4 0))
(setq yesno t)
(progn
(setq tc (assoc 8 aa)
tx (assoc 6 aa)
ty (assoc 62 aa)
)
(setq tyy (cadr (assoc (cdr tc) nn1))
txx (caddr (assoc (cdr tc) nn1))
)
(setq ttt1 f)
(if (= tt1 0)
(setq ttt1 t)
)
(if (and (not (= tt1 0))
(= (car (nth (1- tt1) nn1)) (cdr tc))
)
(setq ttt1 t)
)
;;处理层
(setq ttt2 f)
(if (= tt2 0)
(setq ttt2 t) ;处理线型
(if (NULL tx)
(if (= (nth (1- tt2) nn2) txx)
(setq ttt2 t)
)
(if (= (nth (1- tt2) nn2) (cdr tx))
(setq ttt2 t)
)
)
)
(setq ttt3 f) ;处理颜色
(if (= tt3 0)
(setq ttt3 t)
(if (NULL ty)
(if (= tt3 tyy)
(setq ttt3 t)
)
(if (= tt3 (cdr ty))
(setq ttt3 t)
)
)
)
(setq ttt4 f) ;处理实体
(if (= tt4 0)
(setq ttt4 t)
(if (= (nth (1- tt4) nn4) name)
(setq ttt4 t)
)
)
(setq yesno (and ttt1 ttt2 ttt3 ttt4))
)
)
(if (= yesno t)
(progn
(if (and (or (= moname "DIMEMSION")
(= moname "CIRCLE")
(= moname "ARC")
(= moname "INSERT")
(= moname "LINE")
(= moname "PLINE")
(= moname "LEADER")
)
(or (= name "DIMEMSION")
(= name "INSERT")
(= name "LINE")
(= name "CIRCLE")
(= name "ARC")
(= name "PLINE")
(= name "LEADER")
)
)
(progn
(if (= xx 1)
(myreplace 6)
)
(if (= xxbl 1)
(myreplace 48)
)
)
)
(if
(and
(or (= name "TEXT")
(= name "MTEXT")
(= name "ATTDEF")
)
(or (= moname "TEXT")
(= moname "MTEXT")
(= moname "ATTDEF")
)
)
(progn
(if (= wzlx 1)
(myreplace 7)
) ;自设系统变量，如果sss不为空，一切字体类型都要更换
(if (= zxbl 1)
(if (or (= moname "MTEXT") (= name "MTEXT"))
()
(myreplace 41)
)
) ;字宽比
(if (= zg 1)
(myreplace 40)
) ;字高
(if (= ztjd 1)
(myreplace 50)
) ;逆时针弧度值
(if (= ztjd 1)
(myreplace 51)
) ;斜体斜角弧度值
)
)
(if
(and (or (= name "TEXT")
(= name "MTEXT")
(= name "DIMENSION")
)
(or (= moname "TEXT")
(= moname "MTEXT")
(= moname "DIMENSION")
)
)
(if (= wznr 1)
(myreplace 1)
) ;文字内容
)
;;以下两项为专属修改
(if (and (= moname "DIMENSION") (= "DIMENSION" name))
(if (= cc 1)
(progn
(modim)
(myreplace 3) ;改变尺寸的标注风格
) ;改变尺寸
)
)
(if (and (= moname "SOLID") (= name "SOLID") (= jt 1))
(mysol)
) ;改变箭头的大小
(if (and (or (= moname "CIRCLE") (= moname "ARC"))
(or (= name "CIRCLE") (= name "ARC"))
(= bj 1)
)
(myreplace 40)
) ;半径
;;以下两项为基本属性修改
(if (= c 1)
(myreplace 8)
) ;层
(if (= yc 1)
(myreplace 62)
) ;颜色
)
)
(setq n (1+ n))
)
)
;;本程序主程序
(if (setq sss (entsel "\n 拾取刷子原形："))
(progn
(command "UNDO" "Begin")
(setq mother (entget (car sss)))
(setq moname (cdr (assoc 0 mother)))
(setq standard
(list -3
'("ACAD" (1000 . "DSTYLE") (1002 . "{") (1002 . "}"))
)
)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line
"brush : dialog { label = \"分类格式刷欢迎使用! HUIHL\"; : boxed_column { label = \"要刷取的项目\"; : row { : column { : toggle { label = \"线型\"; key = \"xx\"; mnemonic = \"E\"; fixed_width = true; } : toggle { label = \"线型比例\"; key = \"xxbl\"; mnemonic = \"M\"; fixed_width = true; } "
fn
)
(write-line " : toggle {" fn)
(write-line " label = \"颜色\";" fn)
(write-line " key = \"yc\";" fn)
(write-line " width=16;" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"文字类型\";" fn)
(write-line " key = \"wzlx\";" fn)
(write-line " mnemonic = \"N\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"字高\";" fn)
(write-line " key = \"zg\";" fn)
(write-line " mnemonic = \"Q\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"字形比例\";" fn)
(write-line " key = \"zxbl\";" fn)
(write-line " mnemonic = \"I\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"文字内容\";" fn)
(write-line " key = \"wznr\";" fn)
(write-line " mnemonic = \"I\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line "" fn)
(write-line " }" fn)
(write-line " : column {" fn)
(write-line " : toggle {" fn)
(write-line " label = \"尺寸\";" fn)
(write-line " key = \"cc\";" fn)
(write-line " mnemonic = \"s\";" fn)
(write-line " width=15;" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"层\";" fn)
(write-line " key = \"c\";" fn)
(write-line " mnemonic = \"d\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"箭头(散)\";" fn)
(write-line " key = \"jt\";" fn)
(write-line " mnemonic = \"T\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " : toggle {" fn)
(write-line " label = \"字体角度\";" fn)
(write-line " key = \"ztjd\";" fn)
(write-line " mnemonic = \"a\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line " " fn)
(write-line "" fn)
(write-line "" fn)
(write-line "" fn)
(write-line " : toggle {" fn)
(write-line " label = \"圆、弧半径\";" fn)
(write-line " key = \"bj\";" fn)
(write-line " mnemonic = \"p\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " }" fn)
(write-line " : toggle {" fn)
(write-line
" label = \"色、层绝对\";"
fn
)
(write-line " key = \"scjd\";" fn)
(write-line " mnemonic = \"u\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line "" fn)
(write-line " " fn)
(write-line "" fn)
(write-line "" fn)
(write-line "" fn)
(write-line "" fn)
(write-line " } //column" fn)
(write-line "" fn)
(write-line "" fn)
(write-line "" fn)
(write-line " } //row " fn)
(write-line "" fn)
(write-line ":text{" fn)
(write-line "value=\"Email//:huihl@netease.com\";" fn)
(write-line "is_bold=false;" fn)
(write-line "height=1;} " fn)
(write-line "" fn)
(write-line ":row{ : toggle {" fn)
(write-line " label = \"反向选中\";" fn)
(write-line " key = sf;" fn)
(write-line " mnemonic = \"u\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line "" fn)
(write-line " : toggle {" fn)
(write-line " label = \"记住选择\";" fn)
(write-line " key = jzxz;" fn)
(write-line " mnemonic = \"u\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line "}" fn)
(write-line "" fn)
(write-line " } //box" fn)
(write-line "" fn)
(write-line "" fn)
(write-line ":row{" fn)
(write-line "" fn)
(write-line ":text{" fn)
(write-line
"value=\"下列是对象选择过滤器(与型,色层绝对)\";"
fn
)
(write-line "is_bold=false;" fn)
(write-line "height=1;} " fn)
(write-line " : toggle {" fn)
(write-line " label = \"全选/框选\";" fn)
(write-line " key = qx;" fn)
(write-line " mnemonic = \"u\";" fn)
(write-line " fixed_width = true;" fn)
(write-line " } " fn)
(write-line "" fn)
(write-line "" fn)
(write-line "}//endrow" fn)
(write-line "" fn)
(write-line " " fn)
(write-line ":boxed_row{" fn)
(write-line ":column{ " fn)
(write-line ":popup_list{" fn)
(write-line " key=\"tt1\";" fn)
(write-line " width=10;" fn)
(write-line " list=\"\";" fn)
(write-line " }" fn)
(write-line "" fn)
(write-line ":popup_list{" fn)
(write-line " key=\"tt2\";" fn)
(write-line " width=10;" fn)
(write-line " list=\"\";" fn)
(write-line " }" fn)
(write-line "}" fn)
(write-line "" fn)
(write-line "" fn)
(write-line ":column{ " fn)
(write-line ":popup_list{" fn)
(write-line " key=\"tt3\";" fn)
(write-line " width=10;" fn)
(write-line " list=\"\";" fn)
(write-line " }" fn)
(write-line "" fn)
(write-line ":popup_list{" fn)
(write-line " key=\"tt4\";" fn)
(write-line " width=10;" fn)
(write-line " list=\"\";" fn)
(write-line " }" fn)
(write-line "}" fn)
(write-line "}//endrow" fn)
(write-line "ok_cancel;" fn)
(write-line "} //dialog" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while
(or (eq (substr (setq lin
(vl-string-right-trim
"\" fn)"
(vl-string-left-trim "(write-line \"" (read-line fn))
)
)
1
2
)
"//"
)
(eq (substr lin 1 (vl-string-search " " lin)) "")
(not (eq (substr lin (+ (vl-string-search " " lin) 1) 9)
" : dialog"
)
)
)
)
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(if (= jzxz 1)
(init)
)
(initl)
(setq mc (assoc 8 mother)
mx (assoc 6 mother)
my (assoc 62 mother)
)
(setq myy (cadr (assoc (cdr mc) nn1))
mxx (caddr (assoc (cdr mc) nn1))
)
(action_tile "accept" "(do_set)(done_dialog 1)")
(setq return# (start_dialog))
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
(if (= return# 1)
(ok_do)
)
(command "UNDO" "End")
)
)
(princ)
)

;;本程序是类似于R14应用程序中经常用的格式刷的功能 
(defun c:ddbrush (/        #SPIN AA    BJ          BLK        C     CC    DCLID EE 
                  F        FN    FNAME ID          JT        JZXZ  LEN   LENG  LIN 
                  MC        MONAME            MOTHER        MX    MXX   MY          MYY 
                  N        NAME  NN1   NN2          NN3        NN4   OK    PT3          QX 
                  RATE        SCJD  SF    SS          SSS        STANDARD    STR          TC 
                  TNAME        TT1   TT2   TT3          TT4        TTT1  TTT2  TTT3  TTT4 
                  TX        TXX   TY    TYY          WZLX        WZNR  XX    XXBL  YC 
                  YESNO        ZG    ZTJD  ZXBL 
                 ) 
   
  (defun spin (wh) 
    (prompt (strcat "\r  " 
                    wh 
                    (cond ((= #spin "|") (setq #spin "/")) 
                          ((= #spin "/") (setq #spin "-")) 
                          ((= #spin "-") (setq #spin "\\")) 
                          (T (setq #spin "|")) 
                    ) 
            ) 
    ) 
    (princ) 
  ) 
   
  (defun modim (/ exmo exmo3 exch) 
    (setq exmo (entget (car sss) '("ACAD"))) 
    (setq exmo3 (assoc -3 exmo)) 
    (setq exch (entget ee '("ACAD"))) 
    (princ "\nsecond\n\n") 
    (princ exch) 
    (princ "\n\n first\n") 
    (princ exmo3) 
    (if        (not (or (NULL (assoc -3 exch)) (NULL exmo3))) 
      (setq exch (subst exmo3 (assoc -3 exch) exch)) 
    ) 
    (if        (NULL (assoc -3 exch)) 
      (setq exch (append exch (list exmo3))) 
    ) 
    (if        (NULL exmo3) 
      (setq exch (subst standard (assoc -3 exch) exch)) 
    ) 
    (princ "\n\nstart newsecond\n") 
    (princ exch) 
    (princ "\n\nend\n") 
    (entmod exch) 
  ) 
 
  (defun myreplace (attrib / variey1 variey2 variety xxxx yyyy) 
    (if        (NULL variey1) 
      (setq variey1 (assoc attrib aa)) 
    ) 
    (setq variey2 (cdr (assoc attrib mother))) 
    (if        (NULL variey2) 
      (setq variey2 (assoc attrib mother)) 
    ) 
    (if        (and (not (null variey1)) (not (null variey2))) 
      (progn (setq aa 
                    (subst (cons attrib variey2) (assoc attrib aa) aa) 
             ) 
             (entmod aa) 
      ) 
    ) 
    (if        (and (null variey1) (not (null variey2))) 
      (setq aa (append aa (list (assoc attrib mother)))) 
    ) 
    ;;以下，母没有子有，即母属性随层，但子属性不随层,分三种情况。。。。。(不知何故cond总是有问题，故用三个if的拙法完 
    (if        (= scjd 1) 
      (setq xxxx mxx 
            yyyy myy 
      ) 
      (setq xxxx "BYLAYER" 
            yyyy 256 
      ) 
    )                                        ;用于色层绝对 
 
    (if        (and (not (null variey1)) (null variey2) (= attrib 6)) 
      (setq aa (subst (cons attrib xxxx) (assoc attrib aa) aa)) 
    )                                        ;线型 
    (if        (and (not (null variey1)) (null variey2) (= attrib 62)) 
      (setq aa (subst (cons attrib yyyy) (assoc attrib aa) aa)) 
    )                                        ;颜色,注：随层为256;随块为0 
    ;;以下是母子都没有的情况 
    (if        (and (null variey1) (null variey2) (= attrib 6)) 
      (setq aa (append aa (list (cons attrib xxxx)))) 
    ) 
    (if        (and (null variey1) (null variey2) (= attrib 62)) 
      (setq aa (append aa (list (cons attrib yyyy)))) 
    ) 
    (if        (and (not (null variey1)) (null variey2) (= attrib 48)) 
      (progn (setq aa (subst (cons attrib 1) (assoc attrib aa) aa)) 
             (princ "ok") 
             (princ aa) 
      ) 
    )                                        ;线型比例 
    (entmod aa) 
  ) 
 
  (defun mysol (/ ll pt0 pt1)                ;该函数用于修改箭头的大小 
    (setq ll (distance (cdr (assoc 10 mother)) (cdr (assoc 13 mother)))) 
    (setq pt0 (cdr (assoc 10 aa)) 
          pt1 (cdr (assoc 11 aa)) 
          pt3 (cdr (assoc 13 aa)) 
    ) 
    (setq rate (/ ll (distance pt0 pt3))) 
    (setq pt0 (snpt pt3 pt0 rate) 
          pt1 (snpt pt3 pt1 rate) 
    ) 
    (setq aa 
           (subst (cons 10 pt0) (assoc 10 aa) aa) 
    ) 
    (setq aa 
           (subst (cons 11 pt1) (assoc 11 aa) aa) 
    ) 
    (entmod aa) 
  ) 
 
  (defun snpt (p1 p2 rate / sx1 sx2 sx3 sy1 sy2 sy3) 
    (setq sx1 (car p1) 
          sy1 (cadr p1) 
          sx2 (car p2) 
          sy2 (cadr p2) 
    ) 
    (setq sx3 (+ (* rate (- sx2 sx1)) sx1)) 
    (setq sy3 (+ (* rate (- sy2 sy1)) sy1)) 
    (list sx3 sy3 0.0) 
  ) 
 
  (defun do_set        () 
    (setq sf (atoi (get_tile "sf"))) 
    (setq jzxz (atoi (get_tile "jzxz"))) 
    (if        (= sf 1) 
      (setq n 1) 
      (setq n 0) 
    ) 
    (setq xx (+ (atoi (get_tile "xx")) n)) 
    (setq xxbl (+ (atoi (get_tile "xxbl")) n)) 
    (setq yc (+ (atoi (get_tile "yc")) n)) 
    (setq wzlx (+ (atoi (get_tile "wzlx")) n)) 
    (setq zg (+ (atoi (get_tile "zg")) n)) 
    (setq zxbl (+ (atoi (get_tile "zxbl")) n)) 
    (setq wznr (+ (atoi (get_tile "wznr")) n)) 
    (setq cc (+ (atoi (get_tile "cc")) n)) 
    (setq c (+ (atoi (get_tile "c")) n)) 
    (setq jt (+ (atoi (get_tile "jt")) n)) 
    (setq ztjd (+ (atoi (get_tile "ztjd")) n)) 
    (setq bj (+ (atoi (get_tile "bj")) n)) 
    (setq scjd (+ (atoi (get_tile "scjd")) n)) 
    (setq tt1 (atoi (get_tile "tt1"))) 
    (setq tt2 (atoi (get_tile "tt2"))) 
    (setq tt3 (atoi (get_tile "tt3"))) 
    (setq tt4 (atoi (get_tile "tt4"))) 
    (setq qx (atoi (get_tile "qx"))) 
    (setq ok 1) 
  ) 
 
  (defun init () 
    (set_tile "jzxz" (itoa jzxz)) 
    (if        (= sf 1) 
      (setq n 1) 
      (setq n 0) 
    ) 
    (set_tile "sf" (itoa sf)) 
    (set_tile "xx" (itoa (- xx n))) 
    (set_tile "xxbl" (itoa (- xxbl n))) 
    (set_tile "yc" (itoa (- yc n))) 
    (set_tile "wzlx" (itoa (- wzlx n))) 
    (set_tile "zg" (itoa (- zg n))) 
    (set_tile "zxbl" (itoa (- zxbl n))) 
    (set_tile "wznr" (itoa (- wznr n))) 
    (set_tile "cc" (itoa (- cc n))) 
    (set_tile "c" (itoa (- c n))) 
    (set_tile "jt" (itoa (- jt n))) 
    (set_tile "ztjd" (itoa (- ztjd n))) 
    (set_tile "bj" (itoa (- bj n))) 
    (set_tile "scjd" (itoa (- scjd n))) 
    (set_tile "qx" (itoa qx)) 
  ) 
 
  (defun initl () 
    (setq nn1 '() 
          nn2 '() 
          nn3 '() 
          nn4 '("LINE"            "PLINE"        "CIRCLE"    "ARC" 
                "TEXT"            "MTEXT"        "ATTDEF"    "DIMENSION" 
                "INSERT"    "SOLID" 
               ) 
          n   0 
    ) 
    (start_list "tt1" 3) 
    (add_list "过滤层(不过滤)") 
    (setq blk (tblnext "LAYER" 1)) 
    (while (not (NULL blk)) 
      (setq n (1+ n)) 
      (setq tname (cdr (nth 1 blk))) 
      (setq nn1 
             (append nn1 
                     (list (list tname (cdr (nth 3 blk)) (cdr (nth 4 blk)))) 
             ) 
      ) 
      (add_list tname) 
      (setq blk (tblnext "LAYER" NIL)) 
    ) 
    (end_list) 
    (start_list "tt2" 3) 
    (add_list "过滤线型(不过滤)") 
    (setq blk (tblnext "LTYPE" 1)) 
    (while (not (NULL blk)) 
      (setq tname (cdr (nth 1 blk))) 
      (setq nn2 (append nn2 (list tname))) 
      (add_list tname) 
      (setq blk (tblnext "LTYPE" NIL)) 
    ) 
    (end_list) 
    (start_list "tt3" 3) 
    (add_list "过滤颜色(不过滤)") 
    (setq n 0) 
    (repeat 255 
      (setq n (1+ n)) 
      (add_list (itoa n)) 
    ) 
    (end_list) 
    (start_list "tt4" 3) 
    (add_list "过滤实体(不过滤)") 
    (setq n 0) 
    (setq len (length nn4)) 
    (repeat len 
      (add_list (nth n nn4)) 
      (setq n (1+ n)) 
    ) 
    (end_list) 
  ) 
 
  (defun ok_do () 
    (print "请选择要修改的实体") 
    (if        (= qx 1) 
      (setq ss (ssget "x")) 
      (setq ss (ssget)) 
    ) 
    (setq leng (sslength ss) 
          n    0 
          str  "" 
    ) 
    (repeat leng 
      (spin "请您耐心等待，程序正在处理......") 
      (setq ee (ssname ss n)) 
      (setq aa (entget ee)) 
      (setq name (cdr (assoc 0 aa))) 
      (setq yesno f) 
      (if (and (= tt1 0) (= tt2 0) (= tt3 0) (= tt4 0)) 
        (setq yesno t) 
        (progn 
          (setq        tc (assoc 8 aa) 
                tx (assoc 6 aa) 
                ty (assoc 62 aa) 
          ) 
          (setq        tyy (cadr (assoc (cdr tc) nn1)) 
                txx (caddr (assoc (cdr tc) nn1)) 
          ) 
          (setq ttt1 f) 
          (if (= tt1 0) 
            (setq ttt1 t) 
          ) 
          (if (and (not (= tt1 0)) 
                   (= (car (nth (1- tt1) nn1)) (cdr tc)) 
              ) 
            (setq ttt1 t) 
          ) 
          ;;处理层 
          (setq ttt2 f) 
          (if (= tt2 0) 
            (setq ttt2 t)                ;处理线型 
            (if        (NULL tx) 
              (if (= (nth (1- tt2) nn2) txx) 
                (setq ttt2 t) 
              ) 
              (if (= (nth (1- tt2) nn2) (cdr tx)) 
                (setq ttt2 t) 
              ) 
            ) 
          ) 
          (setq ttt3 f)                        ;处理颜色 
          (if (= tt3 0) 
            (setq ttt3 t) 
            (if        (NULL ty) 
              (if (= tt3 tyy) 
                (setq ttt3 t) 
              ) 
              (if (= tt3 (cdr ty)) 
                (setq ttt3 t) 
              ) 
            ) 
          ) 
          (setq ttt4 f)                        ;处理实体 
          (if (= tt4 0) 
            (setq ttt4 t) 
            (if        (= (nth (1- tt4) nn4) name) 
              (setq ttt4 t) 
            ) 
          ) 
          (setq yesno (and ttt1 ttt2 ttt3 ttt4)) 
        ) 
      ) 
      (if (= yesno t) 
        (progn 
          (if (and (or (= moname "DIMEMSION") 
                       (= moname "CIRCLE") 
                       (= moname "ARC") 
                       (= moname "INSERT") 
                       (= moname "LINE") 
                       (= moname "PLINE") 
                       (= moname "LEADER") 
                   ) 
                   (or (= name "DIMEMSION") 
                       (= name "INSERT") 
                       (= name "LINE") 
                       (= name "CIRCLE") 
                       (= name "ARC") 
                       (= name "PLINE") 
                       (= name "LEADER") 
                   ) 
              ) 
            (progn 
              (if (= xx 1) 
                (myreplace 6) 
              ) 
              (if (= xxbl 1) 
                (myreplace 48) 
              ) 
            ) 
          ) 
          (if 
            (and 
              (or (= name "TEXT") 
                  (= name "MTEXT") 
                  (= name "ATTDEF") 
              ) 
              (or (= moname "TEXT") 
                  (= moname "MTEXT") 
                  (= moname "ATTDEF") 
              ) 
            ) 
             (progn 
               (if (= wzlx 1) 
                 (myreplace 7) 
               )                        ;自设系统变量，如果sss不为空，一切字体类型都要更换 
               (if (= zxbl 1) 
                 (if (or (= moname "MTEXT") (= name "MTEXT")) 
                   () 
                   (myreplace 41) 
                 ) 
               )                        ;字宽比 
               (if (= zg 1) 
                 (myreplace 40) 
               )                        ;字高 
 
               (if (= ztjd 1) 
                 (myreplace 50) 
               )                        ;逆时针弧度值 
               (if (= ztjd 1) 
                 (myreplace 51) 
               )                        ;斜体斜角弧度值 
             ) 
          ) 
          (if 
            (and (or (= name "TEXT") 
                     (= name "MTEXT") 
                     (= name "DIMENSION") 
                 ) 
                 (or (= moname "TEXT") 
                     (= moname "MTEXT") 
                     (= moname "DIMENSION") 
                 ) 
            ) 
             (if (= wznr 1) 
               (myreplace 1) 
             )                                ;文字内容 
          ) 
          ;;以下两项为专属修改 
          (if (and (= moname "DIMENSION") (= "DIMENSION" name)) 
            (if        (= cc 1) 
              (progn 
                (modim) 
                (myreplace 3)                ;改变尺寸的标注风格 
              )                                ;改变尺寸 
            ) 
          ) 
          (if (and (= moname "SOLID") (= name "SOLID") (= jt 1)) 
            (mysol) 
          )                                ;改变箭头的大小 
          (if (and (or (= moname "CIRCLE") (= moname "ARC")) 
                   (or (= name "CIRCLE") (= name "ARC")) 
                   (= bj 1) 
              ) 
            (myreplace 40) 
          )                                ;半径 
          ;;以下两项为基本属性修改 
          (if (= c 1) 
            (myreplace 8) 
          )                                ;层 
          (if (= yc 1) 
            (myreplace 62) 
          )                                ;颜色 
        ) 
      ) 
      (setq n (1+ n)) 
    ) 
  ) 
 
  ;;本程序主程序 
  (if (setq sss (entsel "\n 拾取刷子原形：")) 
    (progn 
      (command "UNDO" "Begin") 
      (setq mother (entget (car sss))) 
      (setq moname (cdr (assoc 0 mother))) 
      (setq standard 
             (list -3 
                   '("ACAD" (1000 . "DSTYLE") (1002 . "{") (1002 . "}")) 
             ) 
      ) 
      (setq fname (vl-filename-mktemp nil nil ".dcl")) 
      (setq fn (open fname "w")) 
      (write-line 
        "brush : dialog {    label = \"分类格式刷 欢迎使用!  HUIHL\";    : boxed_column {        label = \"要刷取的项目\";        : row {            : column {                : toggle {                    label = \"线型\";                    key = \"xx\";                    mnemonic = \"E\";                    fixed_width = true;                }                  : toggle {                    label = \"线型比例\";                    key = \"xxbl\";                    mnemonic = \"M\";                    fixed_width = true;                }  " 
        fn 
      ) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"颜色\";" fn) 
      (write-line "                    key =  \"yc\";" fn) 
      (write-line "                    width=16;" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"文字类型\";" fn) 
      (write-line "                    key = \"wzlx\";" fn) 
      (write-line "                    mnemonic = \"N\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"字高\";" fn) 
      (write-line "                    key = \"zg\";" fn) 
      (write-line "                    mnemonic = \"Q\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"字形比例\";" fn) 
      (write-line "                    key = \"zxbl\";" fn) 
      (write-line "                    mnemonic = \"I\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"文字内容\";" fn) 
      (write-line "                    key = \"wznr\";" fn) 
      (write-line "                    mnemonic = \"I\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "" fn) 
      (write-line "            }" fn) 
      (write-line "            : column {" fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"尺寸\";" fn) 
      (write-line "                    key = \"cc\";" fn) 
      (write-line "                    mnemonic = \"s\";" fn) 
      (write-line "                        width=15;" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"层\";" fn) 
      (write-line "                    key = \"c\";" fn) 
      (write-line "                    mnemonic = \"d\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"箭头(散)\";" fn) 
      (write-line "                    key = \"jt\";" fn) 
      (write-line "                    mnemonic = \"T\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                    label = \"字体角度\";" fn) 
      (write-line "                    key = \"ztjd\";" fn) 
      (write-line "                    mnemonic = \"a\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "            " fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "                : toggle {" fn) 
      (write-line "                   label = \"圆、弧半径\";" fn) 
      (write-line "                   key = \"bj\";" fn) 
      (write-line "                   mnemonic = \"p\";" fn) 
      (write-line "                   fixed_width = true;" fn) 
      (write-line "                }" fn) 
      (write-line "                : toggle {" fn) 
      (write-line 
        "                    label = \"色、层绝对\";" 
        fn 
      ) 
      (write-line "                    key = \"scjd\";" fn) 
      (write-line "                    mnemonic = \"u\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "" fn) 
      (write-line "                " fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "            }        //column" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "        }        //row        " fn) 
      (write-line "" fn) 
      (write-line ":text{" fn) 
      (write-line "value=\"Email//:huihl@netease.com\";" fn) 
      (write-line "is_bold=false;" fn) 
      (write-line "height=1;}        " fn) 
      (write-line "" fn) 
      (write-line ":row{   : toggle {" fn) 
      (write-line "                    label = \"反向选中\";" fn) 
      (write-line "                    key = sf;" fn) 
      (write-line "                    mnemonic = \"u\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }  " fn) 
      (write-line "" fn) 
      (write-line " : toggle {" fn) 
      (write-line "                    label = \"记住选择\";" fn) 
      (write-line "                    key = jzxz;" fn) 
      (write-line "                    mnemonic = \"u\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }   " fn) 
      (write-line "}" fn) 
      (write-line "" fn) 
      (write-line "        }        //box" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line ":row{" fn) 
      (write-line "" fn) 
      (write-line ":text{" fn) 
      (write-line 
        "value=\"下列是对象选择过滤器(与型,色层绝对)\";" 
        fn 
      ) 
      (write-line "is_bold=false;" fn) 
      (write-line "height=1;}        " fn) 
      (write-line " : toggle {" fn) 
      (write-line "                    label = \"全选/框选\";" fn) 
      (write-line "                    key = qx;" fn) 
      (write-line "                    mnemonic = \"u\";" fn) 
      (write-line "                    fixed_width = true;" fn) 
      (write-line "                }   " fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line "}//endrow" fn) 
      (write-line "" fn) 
      (write-line "  " fn) 
      (write-line ":boxed_row{" fn) 
      (write-line ":column{  " fn) 
      (write-line ":popup_list{" fn) 
      (write-line "                key=\"tt1\";" fn) 
      (write-line "                width=10;" fn) 
      (write-line "                list=\"\";" fn) 
      (write-line "                }" fn) 
      (write-line "" fn) 
      (write-line ":popup_list{" fn) 
      (write-line "                key=\"tt2\";" fn) 
      (write-line "                width=10;" fn) 
      (write-line "                list=\"\";" fn) 
      (write-line "                }" fn) 
      (write-line "}" fn) 
      (write-line "" fn) 
      (write-line "" fn) 
      (write-line ":column{  " fn) 
      (write-line ":popup_list{" fn) 
      (write-line "                key=\"tt3\";" fn) 
      (write-line "                width=10;" fn) 
      (write-line "                list=\"\";" fn) 
      (write-line "                }" fn) 
      (write-line "" fn) 
      (write-line ":popup_list{" fn) 
      (write-line "                key=\"tt4\";" fn) 
      (write-line "                width=10;" fn) 
      (write-line "                list=\"\";" fn) 
      (write-line "                }" fn) 
      (write-line "}" fn) 
      (write-line "}//endrow" fn) 
      (write-line "ok_cancel;" fn) 
      (write-line "}        //dialog" fn) 
      (close fn) 
      (setq fn (open fname "r")) 
      (setq dclid (load_dialog fname)) 
      (while 
        (or (eq        (substr        (setq lin 
                               (vl-string-right-trim 
                                 "\" fn)" 
                                 (vl-string-left-trim "(write-line \"" (read-line fn)) 
                               ) 
                        ) 
                        1 
                        2 
                ) 
                "//" 
            ) 
            (eq (substr lin 1 (vl-string-search " " lin)) "") 
            (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) 
                     " : dialog" 
                 ) 
            ) 
        ) 
      ) 
      (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid) 
      (if (= jzxz 1) 
        (init) 
      ) 
      (initl) 
      (setq mc (assoc 8 mother) 
            mx (assoc 6 mother) 
            my (assoc 62 mother) 
      ) 
      (setq myy        (cadr (assoc (cdr mc) nn1)) 
            mxx        (caddr (assoc (cdr mc) nn1)) 
      ) 
      (action_tile "accept" "(do_set)(done_dialog 1)") 
      (setq return# (start_dialog)) 
      (unload_dialog dclid) 
      (close fn) 
      (vl-file-delete fname) 
      (if (= return# 1) 
        (ok_do) 
      ) 
      (command "UNDO" "End") 
    ) 
  ) 
  (princ) 
)

chleiwu · 发表于 2012-12-19 09:27:38

wudechao 发表于 2012-10-21 18:31
(defun ef:undobegin ()
(setvar "CMDECHO" 0)
(command "_.undo" "_group")

字高、颜色修改都有效
但是比例因子改不过来

账号		自动登录	找回密码
密码			注册

求文字格式刷lsp程序

评分

本帖子中包含更多资源

评分