动态引线标柱lisp的修改

958620832

(defun c:k (/ #erryx001 $orr bb bi code data dcl_re dclname ent ent1 ent2 filen gr i lst name1 name2 nent pt pt0 ptlst stream
               tempname w x x0 x1 xunh y0 y1
            )
  (setvar "OrthoMode" 0)          
  (defun #erryx001 (s)
    (entdel name1)
    (entdel name2)
    (command ".UNDO" "E")
    (setq *error* $orr)
  )       
;函数区域开始===============
;保存peace系统变量，保存到cad安装目录下的PEACESYSVAL.TXT by PEACE 2013/05/25
(defun PEACE:SaveSysVarPeace(valname valvalue infotext / acadpath f datalist data valvalue_old i isthere)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (= infotext "")(setq infotext "no infotext"))
  (if (null (findfile "PEACESYSVAL.TXT"))
    (progn ;若文件不存在
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
      (prin1 (list valname valvalue infotext) f)
      (close f)
    )
    (progn ;若文件已存在
      (setq datalist '())
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
        (while (setq data (read-line f))
              (setq datalist (cons data datalist))
        )
      (close f)
      (setq datalist (reverse datalist))
      (setq       i 0
            isthere 0)
      (repeat (length datalist)
        (if (= valname (car (read (nth i datalist))))
          (progn
          (setq datalist (subst (vl-prin1-to-string (list valname valvalue infotext)) (nth i datalist) datalist))
          (setq isthere 1)
          )
        )
        (setq i (1+ i))
      )
      (if (= 1 isthere)
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
          (prin1 (read (nth 0 datalist)) f)
          (close f)
          (setq i 1)
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (repeat (- (length datalist) 1)
            (write-line "" f)
            (prin1 (read (nth i datalist)) f)
            (setq i (1+ i))
          )
          (close f)
        )
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (write-line "" f)
          (prin1 (list valname valvalue infotext) f)
          (close f)
        )
      )
    )
  )
  (princ)
)
;读取peace系统变量 by PEACE 2013/05/25
(defun PEACE:ReadSysVarPeace( / acadpath data datalist i f)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (findfile "PEACESYSVAL.TXT")
    (progn
    (setq datalist '())
    (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
      (while (setq data (read-line f))
            (setq datalist (cons data datalist))
      )
      (reverse datalist)
    (close f)
    (setq i 0)
    (repeat (length datalist)
      (set (read (car (read (nth i datalist)))) ;注意字符和表之间的转换，字符串是不能作为变量名的
           (cadr (read (nth i datalist)))       ;car对字符串也是不起作用的
      )
      (setq i (1+ i))
    )
    )
  nil
  )
)                               
  ; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs
  (defun reent (ent ptlst / i nent x)
    (setq i -1
          nent '()
    )
    (foreach x ent
      (setq nent (append
                   nent
                   (list (if (and
                               (= (car x) 10)
                               (/= (nth (setq i (1+ i))
                                        ptlst
                                   ) nil
                               )
                             )
                           (cons 10 (nth i ptlst))
                           x
                         )
                   )
                 )
      )
    )
  )
  ; 替换表中第i个元素。
  (defun relst (x i lst)               
    (if (= 0 i)
      (cons x (cdr lst))
      (cons (car lst) (relst x (1- i) (cdr lst)))
    )
  )
(defun SaveSysVar()
  (PEACE:SaveSysVarPeace "PEACE:YX_Txt" PEACE:YX_Txt "YX文字")
  (PEACE:SaveSysVarPeace "PEACE:YX_TextH" PEACE:YX_TextH "YX文字高度")
  (PEACE:SaveSysVarPeace "PEACE:YX_TextW2H" PEACE:YX_TextW2H "YX文字宽高比")
  (PEACE:SaveSysVarPeace "PEACE:YX_TextD" PEACE:YX_TextD "YX文字偏移")
  (PEACE:SaveSysVarPeace "PEACE:YX_TextColor" PEACE:YX_TextColor "YX文字颜色")
  (PEACE:SaveSysVarPeace "PEACE:YX_TextLayer" PEACE:YX_TextLayer "YX文字图层")
  (PEACE:SaveSysVarPeace "PEACE:YX_DIML" PEACE:YX_DIML "YX箭头长度")
  (PEACE:SaveSysVarPeace "PEACE:YX_DIMColor" PEACE:YX_DIMColor "YX引线颜色")
  (PEACE:SaveSysVarPeace "PEACE:YX_DIMLayer" PEACE:YX_DIMLayer "YX引线图层")
  (PEACE:SaveSysVarPeace "PEACE:YX_Ratio" PEACE:YX_Ratio "YX出图比例")
)
(defun GETDATA()
  (setq   PEACE:YX_TextH (atof (get_tile "e00"))
          PEACE:YX_TextColor (atoi (get_tile "e01"))
           PEACE:YX_DIMColor (atoi (get_tile "e02"))
               PEACE:YX_DIML (atof (get_tile "e03"))
              PEACE:YX_TextD (atof (get_tile "e04"))
            PEACE:YX_TextW2H (atof (get_tile "e08"))
          PEACE:YX_TextLayer (get_tile "e10")
           PEACE:YX_DIMLayer (get_tile "e11")
              PEACE:YX_Ratio (atof (get_tile "e12"))
                          bi (/ PEACE:YX_Ratio 100)
  )
)
;局部函数结束=====
  (PEACE:ReadSysVarPeace)
  (setvar "cmdecho" 0)
  (setq $orr *error*)
  (setq *error* #erryx001)
  (command ".UNDO" "BE")
  (if (not PEACE:YX_Txt)(setq PEACE:YX_Txt ""));文字高度
  (if (not PEACE:YX_TextH)(setq PEACE:YX_TextH (getvar "DIMTXT")));文字高度
  (if (not PEACE:YX_TextW2H)(setq PEACE:YX_TextW2H (cdr (assoc 41 (tblsearch "style" (getvar "TEXTSTYLE"))))));文字宽高比
  (if (not PEACE:YX_TextD)(setq PEACE:YX_TextD (getvar "DIMEXO")));文字偏移
  (if (not PEACE:YX_TextColor)(setq PEACE:YX_TextColor (getvar "DIMCLRT")));文字颜色
  (if (or (not PEACE:YX_TextLayer)(= "" PEACE:YX_TextLayer)) (setq PEACE:YX_TextLayer "0"));文字图层
  (if (not PEACE:YX_DIML)(setq PEACE:YX_DIML (getvar "DIMASZ")));箭头长度
  (if (not PEACE:YX_DIMColor)(setq PEACE:YX_DIMColor (getvar "DIMCLRD")));引线颜色
  (if (or (not PEACE:YX_DIMLayer)(= "" PEACE:YX_DIMLayer)) (setq PEACE:YX_DIMLayer "0"));引线图层
  (if (not PEACE:YX_Ratio) (setq PEACE:YX_Ratio 100));出图比例
  (setq   bi (/ PEACE:YX_Ratio 100)
        xunh t
              bb 3
  centerplst '()
      tstyle (getvar "TEXTSTYLE")
  )
  (if (null ptlast)
    (setq ptlast '(0.0 0.0))
  )
  (while (= bb 3)
    (setq dclname (cond
                    ((setq tempname (vl-filename-mktemp "yx.dcl")
                           filen (open tempname "w")
                     )
                      (foreach stream '("\n" "yx1:dialog {\n"
                         "    label = \"引线标柱\" ;\n"
                         "    :row { :edit_box { key = \"e01\" ; width = 30 ;   height = 1.2 ;  }  }\n"
                         "    :row { :button { key = \"e02\" ; label = \"确认\" ;  is_default = true ;   }\n"
                         "           :button { key = \"e04\" ; label = \"设置\" ; }  \n"
                         "           :button { key = \"e03\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
                        )
                        (princ stream filen)
                      )
                      (close filen)
                      tempname
                    )
                  )
    )
    (setq dcl_re (load_dialog dclname))
    (if (not (new_dialog "yx1" dcl_re))
      (exit)
    )
    (set_tile "e01" PEACE:YX_Txt)
    (action_tile "e02" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 1)")
    (action_tile "e04" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 2)")
    (action_tile "e03" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 4)")
    (setq bb (start_dialog))
    (unload_dialog dcl_re)
    (vl-file-delete dclname)
    (if (= bb 2)
      (progn
        (setq dclname (cond
                        ((setq tempname (vl-filename-mktemp "yx.dcl")
                               filen (open tempname "w")
                         )
                          (foreach stream '("\n" "yx1:dialog {\n"
                             "    label = \"引线标柱设置\" ;\n"
                             "    :edit_box { label = \"文字高度\" ; key = \"e00\" ; }\n"
                             "    :edit_box { label = \"宽度比例\" ; key = \"e08\" ; }\n"
                             "    :edit_box { label = \"文字偏移\" ; key = \"e04\" ; }\n"
                             "    :edit_box { label = \"文字颜色\" ; key = \"e01\" ; }\n"
                             "    :edit_box { label = \"文字图层\" ; key = \"e10\" ; }\n"
                             "    :edit_box { label = \"箭头长度\" ; key = \"e03\" ; }\n"
                             "    :edit_box { label = \"引线颜色\" ; key = \"e02\" ; }\n"
                             "    :edit_box { label = \"引线图层\" ; key = \"e11\" ; }\n"
                             "    :edit_box { label = \"出图比例\" ; key = \"e12\" ; }\n"
                             "    :edit_box { label = \"正交对齐\" ; key = \"e07\" ; }\n"
                             "    :row { :button { key = \"e05\" ; label = \"确认\" ;  is_default = true ;   }\n"
                             "           :button { key = \"e09\" ; label = \"默认\" ; }  \n"
                             "           :button { key = \"e06\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
                            )
                            (princ stream filen)
                          )
                          (close filen)
                          tempname
                        )
                      )
        )
        (setq dcl_re (load_dialog dclname))
        (if (not (new_dialog "yx1" dcl_re))
          (exit)
        )
        (set_tile "e00" (rtos PEACE:YX_TextH 2 2))
        (set_tile "e01" (rtos PEACE:YX_TextColor 2 0))
        (set_tile "e02" (rtos PEACE:YX_DIMColor 2 0))
        (set_tile "e03" (rtos PEACE:YX_DIML 2 2))
        (set_tile "e04" (rtos PEACE:YX_TextD 2 2))
        (set_tile "e08" (rtos PEACE:YX_TextW2H 2 2))
        (set_tile "e10" PEACE:YX_TextLayer)
        (set_tile "e11" PEACE:YX_DIMLayer)
        (set_tile "e12" (rtos PEACE:YX_Ratio 2 0))
        (if (= (getvar "ORTHOMODE") 0)
          (set_tile "e07" "关 F8切换")
          (set_tile "e07" "开 F8切换")
        )
        ;(action_tile "e01" "(if (/= (setq c (acad_colordlg PEACE:YX_TextColor)) nil) (set_tile \"e01\" (itoa c)))")
        ;(action_tile "e02" "(if (/=(setq c (acad_colordlg PEACE:YX_DIMColor)) nil) (set_tile \"e02\" (itoa c) ))")
        (action_tile "e05" "(GETDATA)(SaveSysVar)(done_dialog 3)")
        (action_tile "e09" "(set_tile \"e00\" (rtos (getvar \"DIMTXT\") 2 2))(set_tile \"e01\" (itoa (getvar \"DIMCLRT\")))(set_tile \"e02\" (itoa (getvar \"DIMCLRD\")))(set_tile \"e03\" (rtos (getvar \"DIMASZ\") 2 2))(set_tile \"e04\" (rtos (getvar \"DIMEXO\") 2 2))(set_tile \"e08\" (rtos (cdr (assoc 41 (tblsearch \"style\" (getvar \"TEXTSTYLE\")))) 2 2))(set_tile \"e10\" \"J-TEXT\")(set_tile \"e11\" \"J-THIN\")(set_tile \"e12\" \"100\")")
        (action_tile "e06" "(done_dialog 3)")
        (setq bb (start_dialog))
        (unload_dialog dcl_re)
        (vl-file-delete dclname)
  centerplst '()
      tstyle (getvar "TEXTSTYLE")
      )
    )
  )
  (if (= bb 1)
    (progn
      (setq pt0 (getpoint "\n>>> 指定引线起始位置:"))
      (princ (strcat "\n>>> 指定引线基线位置:"))
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 62 PEACE:YX_DIMColor)(cons 8 PEACE:YX_DIMLayer) '(100 . "AcDbPolyline") (cons 90 4) (cons 10 pt0) '(40 . 0.0) (cons 41 (* 0.3 bi PEACE:YX_DIML)) (cons 10 pt0) (cons 10 pt0) (cons 10 pt0))
      )
      (setq ent1 (entget (setq name1 (entlast))))
      (entmake (list '(0 . "TEXT") (cons 62 PEACE:YX_TextColor)(cons 8 PEACE:YX_TextLayer) (cons 1 PEACE:YX_Txt) (cons 10 pt0) (cons 40 (* bi PEACE:YX_TextH))(cons 41 PEACE:YX_TextW2H))
      )
      (setq ent2 (entget (setq name2 (entlast)))
                   w (caadr (textbox ent2))
      )
      (while (progn
               (setq gr (grread t 15 0)
                       code (car gr)
                       data (cadr gr)
               )
               (cond
                 ((= code 2)               ; 键盘区域
                   (redraw)
                   (if (= data 15)
                     (if (= (getvar "ORTHOMODE") 0)
                       (progn
                         (prompt "\n命令: <正交 开>")
                         (setvar "orthomode" 1)
                       )
                       (progn
                         (prompt "\n命令: <正交 关>")
                         (setvar "orthomode" 0)
                       )
                     )
                   )
                 )
                 ((= code 3)               ; 鼠标左击
                   (setq ptlast pt
                               xunh nil
                   )
                 )
                 ((= code 5)               ; 鼠标移动
                   (if (= (getvar "ORTHOMODE") 1)
                     (progn
                       (setq x0 (car ptlast)
                                 y0 (cadr ptlast)
                                 x1 (car data)
                                 y1 (cadr data)
                       )
                       (if (< (abs (- x0 x1)) (* 1.5 bi PEACE:YX_TextH))
                             (setq pt (list x0 y1))
                             (if (< (abs (- y0 y1)) (* 2 bi PEACE:YX_TextH))
                               (setq pt (list x1 y0))
                               (setq pt data)
                             )
                       )
                     )
                     (setq pt data)
                   )
                   (entmod (reent ent1 (list nil (polar pt0 (angle pt0 pt) (* bi PEACE:YX_DIML)) pt (polar pt (if (>
                                                                                                                     (car pt)
                                                                                                                     (car pt0)
                                                                                                                  )
                                                                                                                0
                                                                                                                pi
                                                                                                              ) w
                                                                                                    )
                                       )
                           )
                   )
                   (entmod (subst
                             (cons 10 (list (- (car pt) (if (> (car pt) (car pt0))
                                                          0
                                                          w
                                                        )
                                            ) (+ (cadr pt) (* bi PEACE:YX_TextD))
                                      )
                             )
                             (assoc 10 ent2)
                             ent2
                           )
                   )
                   (redraw)
                 )
                 ((or
                    (= code 11)
                    (= code 25)
                  )                       ; 鼠标右击
                   (entdel name1)
                   (entdel name2)
                   (setq xunh nil)
                   (redraw)
                 )
                 (t
                 )
               )
               xunh
             )
      )
    )
  )
  (command ".UNDO" "E")

修改建议：字体为当前字体，而不限于默认的standard

langjs

记得编程时候默认的字体取的就是当前字体啊

958620832

langjs 发表于 2013-7-26 14:00
记得编程时候默认的字体取的就是当前字体啊

不对吧，我试过很多遍了，不管当前字体是什么字体，引出标注中的文字字体始终是系统默认的standard啊，绝对没错的。建议将字体改为当前字体。

langjs

什么叫当前字体？只听说过当前文字样式，当前文字样式用的啥字体标注文字时候就是啥字体

pzweng

首先获取当前的样式

香田里浪人

默认已经是cad默认字体样式。而cad默认字体样式未必是默认的standard
各人设置不同，

958620832

香田里浪人 发表于 2013-7-27 08:17
默认已经是cad默认字体样式。而cad默认字体样式未必是默认的standard
各人设置不同，

cad默认的字体样式初始为standard，请问如何将cad默认的字体样式修改为其他字体样式，每次打开cad时，cad默认的字体样式都是修改之后的，而不用每次都修改

958620832

langjs 发表于 2013-7-26 22:03
什么叫当前字体？只听说过当前文字样式，当前文字样式用的啥字体标注文字时候就是啥字体

用你编写的动态引线标柱lisp，不管当前文字样式用的啥字体，标注文字时，始终都还是standard字体样式，不信，你可以试一试。

香田里浪人

958620832 发表于 2013-7-27 15:43
用你编写的动态引线标柱lisp，不管当前文字样式用的啥字体，标注文字时，始终都还是standard字体样式，不 ...

可是，我在2004版本下确实可以随意改字体。

egoroom

支持。。。下来试试。。。