动态轴测图工具2014.1月更新(源码)

langjs

yansu 发表于 2012-4-13 08:10
提示没有字体，如何添加字体

不明白为什么会出现缺少字体的提示,程序新建标注式样和文字式样调用的是当前标注式样的字体,只要但前标注式样正常,按道理不会缺少字体.

下面是创建文字和标注式样的子程序,你看看问题出在什么地方?

;;; 程序初始化子程序(建立新的文字式样和标注式样)
(defun zct02 (/ ctrview dsy name pt0 pt1 pt2 pt3 pt4 pt5 sizeview snap thr tsy tsyent)
  (setq tsy (getvar "TEXTSTYLE"))      ; 取得当前文字式样名称
  (setq dsy (getvar "DIMSTYLE"))       ; 取得当前标注式样名称
  (setq tsyent (tblsearch "style" tsy)) ; 取得当前标注式样详细内容
  (setq thr (strcat (cdr (assoc 3 tsyent)) "," (cdr (assoc 4 tsyent)))) ; 取得当前标注式样shx字体和大字体内容
  (if (not (tblsearch "style" "+30"))  ; 文字样式"+30"，无则创建
    (progn
      (command "_style" "+30" thr 0 0.8 30 "N" "N") ; 将当前式样字体赋予新建文字式样
      (if (/= 0 (getvar "cmdactive"))
(command "N")
      )
    )
  )
  (if (not (tblsearch "style" "-30"))  ; 文字样式"-30"，无则创建
    (progn
      (command "_style" "-30" thr 0 0.8 -30 "N" "N")
      (if (/= 0 (getvar "cmdactive"))
(command "N")
      )
    )
  )
  (if (not (tblsearch "dimstyle" "+30")) ; 标注样式"+30"，无则创建
    (progn          ; 新建箭头块
      (setq snap (getvar "osmode"))
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (setvar "cecolor" (itoa (getvar "DIMCLRD")))
      (setq sizeview (getvar "viewsize"))
      (setq ctrview (getvar "viewctr"))
      (setq pt0 '(0.0 0.0 0.0)
     pt1 '(-1.10647 0.184412 0.0)
     pt2 '(-0.89353 -0.184412 0.0)
     pt3 '(-1.10647 -0.184412 0.0)
     pt4 '(-0.89353 0.184412 0.0)
     pt5 '(-0.7 0.0 0.0)
      )
      (command "zoom" "c" pt0 3)
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 pt0) (cons 10 pt1)
       (cons 10 pt2) (cons 10 pt0)
        )
      )
      (setq name (entlast))
      (command "bhatch" "p" "SOLID" pt5 "")
      (entdel name)
      (command "block" "箭头2" pt0 (entlast) "")
      (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 pt0) (cons 10 pt3)
       (cons 10 pt4) (cons 10 pt0)
        )
      )
      (setq name (entlast))
      (command "bhatch" "p" "SOLID" pt5 "")
      (entdel name)
      (command "block" "箭头1" pt0 (entlast) "")
      (command "zoom" "c" ctrview sizeview)
      (setvar "cecolor" "bylayer")
      (setvar "osmode" snap)        ; 新建箭头块结束
      (command "DIMTXSTY" "+30" "DIMBLK1" "箭头1" "DIMBLK2" "箭头1" "DIMSAH" 1 "DIMSTYLE" "S" "+30")
    )
  )
  (if (not (tblsearch "dimstyle" "-30")) ; 标注样式"-30"，无则创建
    (progn
      (command "DIMTXSTY" "-30" "DIMBLK1" "箭头2" "DIMBLK2" "箭头2" "DIMSAH" 1 "DIMSTYLE" "S" "-30")
    )
  )
  (setvar "TEXTSTYLE" tsy)        ; 恢复原来的文字式样
  (command "dimstyle" "r" dsy)        ; 恢复原来的标注式样
  (list tsy dsy)
)

CTC

等老狼有时间优化下

CTC

1）想解决画图有点卡的问题。太卡了，画图始终不是办法。
2）命令行提示有点怪：
命令: zline
指定第一点:
指定下一点,或输入距离:空格默认<14.01>
1
12
122
指定下一点,或输入距离:空格默认<122>
2
22
222
指定下一点,或输入距离:空格默认<222>
3
33
333
指定下一点,或输入距离:空格默认<333>
4
44
444
指定下一点,或输入距离:空格默认<444>
5
55
555
指定下一点,或输入距离:空格默认<555>

longer1000

都是高手啊

fundoll

谢谢楼主提供源程序

fdb2007

回复试一下

langjs

CTC 发表于 2012-4-13 23:40
1）想解决画图有点卡的问题。太卡了，画图始终不是办法。
2）命令行提示有点怪：
命令: zline

卡问题解决不了,命令行提示问题解决了

zhuquanmao

非常的棒！谢谢分享

longer1000

springwillow

郞哥出源码了。谢谢！顶你啊！！