***** 快速好用 自定 線型文字編輯器 *****

前生

GOOD

Aries

p-3-ianlcc

不錯，收藏下來…
很方便使用

paulpipi

感谢分享，非常的有用

海盗曹

厉害厉害，学习一下

love_cq

好贴，占个坑学习下。

sbwdx

持续关注，好用 ！

15062311027

谢谢分享，厉害

明_明

感谢分享好源码！

KO你

楼主的程序挺好的，唯一的缺点就是线型中的文字不在线的起点和终点之间对中
可参考下这个，在论坛里的
;;示例(HH:InputBox "显示重量,便于拷贝" "重量显示" "5.3")
(defun HH:InputBox (promptstr title default)
  ;;(setq str (VL-PRIN1-TO-STRING default))
  (wscriptPublic (strcat "dim ret \n ret=InputBox(\""               promptstr
                         "\", \""            title               "\", \""
                         default            "\")"
                        )
  )
)
;;[功能] 创建带文字的线型
(defun c:makelt (/ EXPRT FILE FN SS STR)
  ;; 错误处理
  (defun *error* (msg)
    (vl-bt)
    (while (not (equal (getvar "cmdnames") "")) (command nil))
    (cond (exprt (setvar 'expert exprt)))
    (setvar "nomutt" 0)
    (princ "\n 出错啦!")
    (princ)
  )
  (setq exprt (getvar 'expert))
  ;;(setq str (getstring T "\n Enter string for linetype: "))
  (setvar "nomutt" 1)
  (cond        ((and (princ "\n 拾取或者输入线型文字")             
              (setq ss (ssget "_+.:E:S" '((0 . "TEXT"))))
         )         
         (setq str (cdr (assoc 1 (entget (ssname ss 0)))))         
        )
        (T         
         (while (equal (setq str (HH:InputBox "线型中有文字" "带文字线型" "电线")) ""))
        )
  )
  (setvar "nomutt" 0)
  (setq File (vl-filename-mktemp nil nil ".lin"))
  ;;(setq file (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) "_mylt.lin"))
  (setq fn (open file "w"))
  (setq exprt (getvar 'expert))
  (write-line (strcat "*" str ", ---" str "---") fn)
  (write-line (strcat "A,0.5,-0.05,[\""
                      str
                      "\",STANDARD,S=0.1,R=0.0,X=-0.0,Y=-.05],"
                      (rtos (* -0.1 (strlen str)) 2 3)
              )
              fn
  )
  (close fn)
  (setvar 'expert 5)
  (command ".-linetype" "load" "*" file "")
  (setvar 'expert exprt)
  (vl-file-delete file);这句好象没有什么用处
  (princ))