[其他]：把line转成text

aeo

以前看过一个把line转成text的程序，都转成 txt,shx里的 "-"字，起到加密的效果。
我觉得这方法挺好的。大家来研究一下如何.

eachy

最初由 aeo 发布
[B]以前看过一个把line转成text的程序，都转成 txt,shx里的 "-"字，起到加密的效果。
我觉得这方法挺好的。大家来研究一下如何. [/B]

有想法，根据线的角度长短变成横的竖的斜的 “-”，还有个问题，那些弧线（arc、circle、ellipse、spline）是否要先模拟？

XDSoft

大家就讨论讨论怎么做SHX吧，模拟的问题可以另外讨论。

陌生人

做shp(shx), “－” ，圆弧，圆都可以做出来，其它的图形就可以用这几个基本形替换，模拟。
只是宽度不好弄，如果通过画笔设置，倒可以解决最终成果基本接近原图。

eachy

最初由 陌生人 发布
[B]做shp(shx), “－” ，圆弧，圆都可以做出来，其它的图形就可以用这几个基本形替换，模拟。
只是宽度不好弄，如果通过画笔设置，倒可以解决最终成果基本接近原图。 [/B]

用颜色区分宽度。

aeo

做shx比较麻烦，要把字形一起拷贝给别人
txt.shx每个cad都一样.

我觉得就转直线就可以，毕竟占图的70-80%.

也只能骗一下不在行的, 其实boudarybox就能还原.

验正高度为1的"-"长 -->做块 -->按比例插入(minsert)

eachy

最初由 aeo 发布
[B]做shx比较麻烦，要把字形一起拷贝给别人
txt.shx每个cad都一样.

我觉得就转直线就可以，毕竟占图的70-80%.

也只能骗一下不在行的, 其实boudarybox就能还原.

验正高度为1的"-"长 -->做块 -->按比例插入(min... [/B]

别光说不练，我来第一个
[program](defun c:test (/ ss ep len p sp thisdrawing txt w)
  (if (setq ss (ssget '((0 . "line"))))
    (progn
      (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
      (vlax-for        i (vla-get-activeselectionset thisdrawing)
        (setq sp  (vlax-curve-getstartpoint i)
              ep  (vlax-curve-getendpoint i)
              len (vla-get-length i)
              w          (* len 1.5)
              p          (polar sp (- (vla-get-angle i) (/ pi 2)) 0.5)
        )
        (setq txt (vla-addtext
                    (vla-get-modelspace thisdrawing)
                    "-"
                    (vlax-3d-point p)
                    1.
                  )
        )
        (vla-put-scalefactor txt w)
        (vla-put-rotation txt (vla-get-angle i))
        (vla-delete i)
      )
    )
  )
  (princ)
)
[/program]

citykunan

Express 中的mkshape有这个功能。

wkai

试试这个~
[program]
(defun c:tt (/ ss e ee p1 p2 a1 d1 hight ins)
  (setq ss (ssget '((0 . "LINE"))))
  (repeat (setq n (sslength ss))
    (setq e (ssname ss (setq n (1- n))))
    (setq ee        (entget e)
          p1        (dxf 10 ee)
          p2        (dxf 11 ee)
          a1        (angle p1 p2)
          d1        (distance p1 p2)
          hight        (/ d1 0.6661841656)
          ins        (polar (polar p1 (+ pi a1) (* hight 0.0002930901))
                       (- a1 (/ pi 2))
                       (* hight 0.5000382646)
                )
          ee        (list '(0 . "TEXT")
                      (assoc 8 ee)
                      (cons 10 ins)
                      (cons 40 hight)
                      '(1 . "-")
                      (cons 50 a1)
                )
    )
    (entmake ee)
    (entdel e)
  )
)
[/program]

aeo

最初由 eachy 发布
高度为1,长度不可能为1


[program]
;;;xlock:字形,自己建一下,txt.shx

(Defun mkblock ( / a b c li name dis)
        (setq li(textbox(list '(0 . "TEXT")'(7 . "XLOCK")'(1 . "-")'(10 0 0 0)'(40 . 1))))

        (setq a(car li)b(cadr li) c(list(/(+(car a)(car b))-2.)(-(cadr a))))
       ;;c为文字的dxf10点，对应 '(0 0 0)

        (setq dis(distance a b)) ;;求高度为1时的宽度

        (entmake (list '(0 . "BLOCK")(cons 2 "*U")'(10 0.0 0.0 0.0)'(70 . 1)))

        (entmake (list '(0 . "TEXT")'(7 . "XLOCK")'(1 . "-")'(8 . "0")(cons 10 c)'(40 . 1)))

        (setq name(entmake (list (cons 0 "endblk"))))

        (list name dis);;建一无名块，插入点在文字的中间.+文字的长度
  )

;;;下面很简单了，插入比例dxf41是(/ length-line dis) dxf42应该无所谓.
;;;这样做外无一失，保证线完全正确。
[/program]

mmmm

[PHP]
;| 2003/3/19
    Locking AutoCAD LINEs by converting LINES into spacebar content text with underline and TXT.SHX style.
Using the underline to simulate the native lines. Design Idea by Yota Masaru.
    Each version of AutoCAD has the same and most common text style file "TXT.SHX", so the underline texts
can be displayed normally in most all AutoCAD platform. By doing so, the end point of lines can NOT be osnap
by any AutoCAD (assistant) commands or methods.
    To convert back the underlines into common lines, we MUST run AutoCAD WMFOUT and WMFIN to make a back
converting operation. Even in this case, the proper location can NOT be revived 100%.
=======================================================================================================
转换直线为空格的下划线 版本0.1Alpha by KozMos Inc.
    使用TXT.SHX字体的空格的下划线来代替文本，用户将无法捕捉到准确的直线端点，也无法进行普通方式的改动一
般情况下可以限制用户对图形的进一步修改。
    为保持程序的简单化，本程序仅仅处理直线，至于哪些复杂实体需要转换成直线由用户手动解决，本程序不作处理。
    本程序全部采用AutoLISP函数功能，适用于所有版本的AutoCAD。
    注意：不要处理虚线。这样处理过的图形，无法精确地转换回来。只有使用模拟的方法将图形转换回来，方法图
形WMFOUT后再导入，不过这样处理后，图形的准确度会降低。|;
(Defun C:XLock (/ GatherBlock txt2line mkstyle mkblock cmdecho osmode sset dxf8 n)
  (Defun txt2line (Obj / DXF10 DXF11 DXF8 DXF62 Scale Rtn)
    (setq DXF8        (cdr (assoc 8 (entget Obj)))
          DXF10        (cdr (assoc 10 (entget Obj)))
          DXF11        (cdr (assoc 11 (entget Obj)))
          DXF62        (cdr (assoc 62 (entget Obj)))
          Scale        (/ (distance DXF10 DXF11) 1.0)
    )
    (if        (or (null DXF62) (= DXF62 0))
      (setq DXF62 (cdr (assoc 62 (tblsearch "Layer" DXF8))))
    )
    (if        (entmake (list (cons 0 "INSERT")
                       (cons 2 "TXT2LINE")
                       (cons 8 "0")
                       (cons 10
                             (polar DXF10
                                    (angle DXF10 DXF11)
                                    (* 0.5 (distance DXF10 DXF11))
                             )
                       )
                       (cons 41 Scale)
                       (cons 42 Scale)
                       (cons 42 Scale)
                       (cons 50 (angle DXF10 DXF11))
                 )
        )
      (progn
        (entdel Obj)
        (command "_.Explode" (entlast))
        (command "_.Change" (ssget "p") "" "_P" "_C" DXF62 "")
      )
    )
  )
  (Defun mkstyle (/ Rtn)
    (if        (null (setq Rtn (tblsearch "Style" "XLOCK")))
      (progn
        (command "_.Style" "XLOCK" "TXT.SHX")
        (while (/= (getvar "CmdNames") "") (command ""))
      )
    )
    (setq Rtn (tblsearch "Style" "XLOCK"))
    Rtn
  )
  (Defun mkblock (/ Rtn)
    (if        (null (setq Rtn (tblsearch "Block" "TXT2LINE")))
      (progn
        (entmake (list (cons 0 "BLOCK")
                       (cons 2 "TXT2LINE")
                       (list 10 0.0 0.0 0.0)
                       (cons 70 2)
                 )
        )
        (entmake (list (cons 0 "TEXT")
                       (cons 1 "%%U ")
                       (cons 7 "XLOCK")
                       (cons 8 "0")
                       (list 10 -0.35 0.2 0.0)
                       (cons 40 1.0)
                       (cons 41 1.0)
                       (cons 50 0.0)
                       (cons 71 0)
                       (cons 72 0)
                       (cons 73 0)
                 )
        )
        (entmake (list (cons 0 "ENDBLK")))
      )
    )
    (setq Rtn (tblsearch "Block" "TXT2LINE"))
    Rtn
  )

  (setq cmdecho (getvar "cmdecho")
        osmode (getvar "osmode")
        )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (if (and (mkstyle)
           (mkblock)
      )
    (progn
      (princ
        "\n 转换直线为空格的下划线 版本0.1Alpha by KozMos Inc.\n 版权所有（1994-2003） 保留所有权利\n\n 请选择转换的直线 <退出>:"
      )
      (if (setq sset (ssget (list (cons 0 "LINE"))))
        (progn
          (setq n -1)
          (repeat (sslength sset)
            (princ (strcat "\r 正在转换 "
                           (itoa (1+ (setq n (1+ n))))
                           "/"
                           (itoa (sslength sset))
                           "; 请稍候......"
                   )
            )
            (txt2line (ssname sset n))
          )
        )
      )
      (princ " 转换完成！")
      ;|(initget "Yes No")
      (setq YN (getkword"\n Lock named block (This may take a while) [Yes/No] <Y>:"))
      (if (or (null YN) (equal YN "Yes"))
        (progn
          (setq BlockX (tblnext "Block" t))
          (while BlockX
            (setq BlockX (tblnext "Block"))
          )          
      ))|;      
    )
  )
  (setvar "osmode" osmode)
  (setvar "cmdecho" cmdecho)
  (princ)
)
;;; Codes for transfer between "%%U " and " "
;;; XL0: "%%U " => " "
;;; XL1: " " => "%%U "
(Defun C:XL0 (/ sset n ent)
  (if (setq sset
             (ssget "x"
                    (list (cons 0 "TEXT") (cons 1 "%%U ") (cons 7 "XLOCK"))
             )
      )
    (progn
      (setq n -1)
      (repeat (sslength sset)
        (setq ent (entget (ssname sset (setq n (1+ n))))
              ent (subst (cons 1 " ") (assoc 1 ent) ent)
        )
        (entmod ent)
      )
    )
  )
  (princ)
)
(Defun C:XL1 (/ sset n ent)
  (if
    (setq
      sset (ssget "x"
                  (list (cons 0 "TEXT") (cons 1 " ") (cons 7 "XLOCK"))
           )
    )
     (progn
       (setq n -1)
       (repeat (sslength sset)
         (setq ent (entget (ssname sset (setq n (1+ n))))
               ent (subst (cons 1 "%%U ") (assoc 1 ent) ent)
         )
         (entmod ent)
       )
     )
  )
  (princ)
)

[/php]

wkai

如果别人用ET文本工具中的 分解成线 ，就白费劲了~

aeo

最初由 mmmm 发布
[B][PHP]
;| 2003/3/19
    Locking AutoCAD LINEs by converting LINES into spacebar content text with underline and TXT.SHX style.
Using the underline to simulate the native lines. Design Idea by Yota M... [/B]

就是我看到的，但是转的不够精确，我的电脑上比线长了.

确实一炸就开，没办法。
不过我用minsert插入，不炸开，要好一点

eachy

最初由 aeo 发布
[B][QUOTE]最初由 mmmm 发布
[B][PHP]
;| 2003/3/19
    Locking AutoCAD LINEs by converting LINES into spacebar content text with underline and TXT.SHX style.
Using the underline to simulate the ... [/B]

有了 Minert <-> Insert 互转分解不是障碍 。

陌生人

最初由 wkai 发布
[B]如果别人用ET文本工具中的 分解成线 ，就白费劲了~ [/B]

有道理，看来还得另辟溪境