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

lee50310

<<<  快速好用   自定 線型文字編輯器  >>>
可快速自定出你自己想要的 線型文字  並指定在那個圖層 也可編輯修改 線型文字
使用指令 :makelt

yangchao2005090

2. ;;http://bbs.mjtd.com/thread-183496-1-1.html
   
3. (defun c:tt (/ cmde lst p1 ss ss1)
   
4.         (setq cmde (getvar "CMDECHO"))
   
5.         (setvar "CMDECHO" 0)
   
6.         (prompt "\n框选需要合并的表格：")
   
7.         (while (setq ss (ssget))
   
8.                 (setq lst (reverse (wyb-get-box ss)))
   
9.                 (setq p1 (caar lst) lst (cdr lst))
   
10.                 (if (/= lst nil)
    
11.                         (foreach x lst
    
12.                                 (setq ss1 (ssget "w" (car x) (cadr x)))
    
13.                                 (vl-cmdf "_.move" ss1 "" "non" (list (caar x) (cadadr x)) "non" p1)
    
14.                                 (setq p1 (polar p1 (* 1.5 pi) (distance (car x) (list (caar x) (cadadr x)))))
    
15.                         )
    
16.                         (prompt "\n没有需要合并的表格。")
    
17.                 )
    
18.                 (prompt "\n框选需要合并的表格：")
    
19.         )
    
20.         (setvar "CMDECHO" cmde)
    
21.         (prompt "\n表格合并完成！")
    
22.         (princ)
    
23. )
    
24. 
    
25. ;|= 4.2. 取得图元外矩形框
    
26. ;@== (wyb-get-box ename)
    
27. ;#== return: [plst]'((x1 y1 z1)_min (x2 y2 z2)_max)
    
28. ;ver:
    
29. ;    [1.0] 明经 Longxin, Gu_xl&邹锋
    
30. ;    [1.1] by woyb 20151010
    
31. ;    [1.1.1] ADD: 释放obj by woyb 20180730
    
32. ;====================|;
    
33. (defun wyb-get-box (@e / p1 p2 p3 p4 obj lst tmp)
    
34.     (setq obj (vlax-ename->vla-object @e))
    
35.     (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'p1 'p3))))
    
36.         (progn
    
37.             (setq p1 (vlax-safearray->list p1)
    
38.                 p3 (vlax-safearray->list p3)
    
39.                 p2 (list (car p1) (cadr p3) (caddr p1))
    
40.                 p4 (list (car p3) (cadr p1) (caddr p1))
    
41.             )
    
42.             (if (= "SPLINE" (cdr (assoc 0 (entget @e))))
    
43.                 (progn
    
44.                     (setq lst
    
45.                         (mapcar '(lambda  (a b) (vlax-curve-getClosestPointToProjection @e a b t))
    
46.                             (list p1 p2 p3 p4)
    
47.                             '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
    
48.                         )
    
49.                     )
    
50.                     (setq tmp
    
51.                         (list
    
52.                             (apply 'mapcar (cons 'min lst))
    
53.                             (apply 'mapcar (cons 'max lst))
    
54.                         )
    
55.                     )
    
56.                 )
    
57.                 (setq tmp (list p1 p3))
    
58.             )
    
59.         )
    
60.         (setq tmp nil)
    
61.     )
    
62.     (vlax-release-object obj)
    
63.     tmp
    
64. )

;;http://bbs.mjtd.com/thread-183496-1-1.html<br /> (defun c:tt (/ cmde lst p1 ss ss1)<br />         (setq cmde (getvar "CMDECHO"))<br />         (setvar "CMDECHO" 0)<br />         (prompt "\n框选需要合并的表格：")<br />         (while (setq ss (ssget))<br />                 (setq lst (reverse (wyb-get-box ss)))<br />                 (setq p1 (caar lst) lst (cdr lst))<br />                 (if (/= lst nil)<br />                         (foreach x lst<br />                                 (setq ss1 (ssget "w" (car x) (cadr x)))<br />                                 (vl-cmdf "_.move" ss1 "" "non" (list (caar x) (cadadr x)) "non" p1)<br />                                 (setq p1 (polar p1 (* 1.5 pi) (distance (car x) (list (caar x) (cadadr x)))))<br />                         )<br />                         (prompt "\n没有需要合并的表格。")<br />                 )<br />                 (prompt "\n框选需要合并的表格：")<br />         )<br />         (setvar "CMDECHO" cmde)<br />         (prompt "\n表格合并完成！")<br />         (princ)<br /> )<br /> <br /> ;|= 4.2. 取得图元外矩形框<br /> ;@== (wyb-get-box ename)<br /> ;#== return: [plst]'((x1 y1 z1)_min (x2 y2 z2)_max)<br /> ;ver: <br /> ;    [1.0] 明经 Longxin, Gu_xl&邹锋<br /> ;    [1.1] by woyb 20151010<br /> ;    [1.1.1] ADD: 释放obj by woyb 20180730<br /> ;====================|;<br /> (defun wyb-get-box (@e / p1 p2 p3 p4 obj lst tmp)<br />     (setq obj (vlax-ename->vla-object @e))<br />     (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'p1 'p3))))<br />         (progn<br />             (setq p1 (vlax-safearray->list p1)<br />                 p3 (vlax-safearray->list p3)<br />                 p2 (list (car p1) (cadr p3) (caddr p1))<br />                 p4 (list (car p3) (cadr p1) (caddr p1))<br />             )<br />             (if (= "SPLINE" (cdr (assoc 0 (entget @e))))<br />                 (progn<br />                     (setq lst<br />                         (mapcar '(lambda  (a b) (vlax-curve-getClosestPointToProjection @e a b t))<br />                             (list p1 p2 p3 p4)<br />                             '((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))<br />                         )<br />                     )<br />                     (setq tmp <br />                         (list<br />                             (apply 'mapcar (cons 'min lst))<br />                             (apply 'mapcar (cons 'max lst))<br />                         )<br />                     )<br />                 )<br />                 (setq tmp (list p1 p3))<br />             )<br />         )<br />         (setq tmp nil)<br />     )<br />     (vlax-release-object obj)<br />     tmp<br /> )

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))

lee50310

yangchao2005090 发表于 2021-8-19 09:16
请问一下，这个线型编辑器生成的线型文件lin文件存放在哪个地方啊

如果你設定一個新線型 則新線型格式 會暫存在 程式的變數 ltdef  內

例: 查看變數內容     可在cad 的 Connand: !ltdef  按Enter

回應: "\n*USER,--- - ---BE--- - ---BE--- - ---BE--- - ---\nA,4.375,-1.25,1.25,-1.25,4.375,-1.91467,[\"BE\",Standard,S=1.5,R=0.0,X=-1.26467,Y=-0.75],-1.91467"

sunqv

上传了，不管用  请问怎么可以做出来废弃线型？

lee50310

sunqv 发表于 2020-12-12 19:39
上传了，不管用  请问怎么可以做出来废弃线型？

廢氣管段 文字線型 操作方式

sunqv

和我上面发的线型不一样呀大神？我那个线型是5mm，1mm空格，实线上面有个x

mokson

太实用了，感谢楼主。

masterlong

很不错
简单的文字线型用这个创建很方便

可以考虑下加入文字旋转角度、是否居中等设定
另外注意下高版本里线型定义里的新参数

masterlong

新参数找到原帖了
http://bbs.mjtd.com/forum.php?mo ... =%D0%C2%B2%CE%CA%FD

lee50310

可以考虑下加入文字旋转角度、是否居中等设定
另外注意下高版本里线型定义里的新参数

感謝回復, 已後新版本可以增加此項

新参数找到原帖了

感謝告知

Yruz

感谢分享，非常的有用

panliang9

谢谢楼主分享。