[LISP函数]：文件与斜线对齐LSP

shenying123

希望能与pline线支持

carrot1983

文字与线对齐。但不改位置

功能：文字齐线
命令：af
适用曲线LINE,ARC,CIRCLE,ELLIPSE


[php]

(defun c:af (/         ang         elist     ename
         i         pt         sscur     sstxt
         jw-angle-curvept         jw-angle-sharp
        )
  (princ "\n文字齐线 carrot1983")
  (vl-load-com)
  ;;(angtos (jw-angle-curvept (car (entsel)) (getpoint)) 0 )
  (defun jw-angle-curvept (ename pt / ang tan)
    (setq tan (vlax-curve-getfirstderiv
        ename
        (vlax-curve-getparamatpoint ename pt)
          )
    )
    (setq
      ang (if (= (car tan) 0)
        (* 0.5 pi)
        (angle (polar pt (atan (/ (cadr tan) (car tan))) 1) pt)
      )
    )
    ang
  )

  ;;(jw-angle-sharp ang)
  (defun jw-angle-sharp    (ang)
    (if    (and (> ang (* 0.5 pi)) ;_1.57
         (< ang (* 1.5 pi)) ;_4.71
    )
      (setq ang (- ang pi))
    )
    ang
  )

  (if (and (setq pt (getpoint "\n点取曲线上一点<退出>: "))
       (setq sstxt (ssget '((0 . "*TEXT"))))
      )
    (progn
      (setq sscur (ssget pt '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
      (setq ang (jw-angle-sharp (jw-angle-curvept (ssname sscur 0) pt)))
      (setq i -1)
      (repeat (sslength sstxt)
    (setq ename (ssname sstxt (setq i (+ i 1))))
    (setq elist (entget ename))
    (setq elist (subst (cons 50 ang) (assoc 50 elist) elist))
    (entmod elist)
      )
    )
  )
  (princ)
)

(princ)

[/php]

hzj526

上面几个程序都不错，对于pline还望高手能够解决

lxch

望14楼给出程序的源码，以利于大家学习，取长补短。

gysjy

最初由 hzj526 发布
[B]上面几个程序都不错，对于pline还望高手能够解决 [/B]

下面是更新后的程序，可支持pline线：
[PHP](defun to(n)
  (cdr (assoc n (entget sn)))
)
(princ "\n欢迎使用文字对齐直线程序! GYSJY  2009.3.9")
(defun c:nn( / a0 ang d dh dq en h n p0 p1 p2 pi pmid sn txt zx)
;将文字对齐到直线上
  (command "undo" "g")
  (setq zx t txt t)
  (while zx  
    (if (setq sn (car (entsel "\n选择线段:")))
      (progn
        (if (= (to 0) "LINE")
          (setq  p1 (to 10) p2 (to 11)
                 ang (angle p1 p2)         
                 d (/ (distance p1 p2) 2) pmid (polar p1 ang d)
          )
          (setq p1 (to 10) p2 (osnap p1 "mid") ang (angle p1 p2) pmid p2)
        )
        (setq ang (if (and (> ang 1.571)(< ang 4.713))(- ang 3.14) ang)
              a0 (+ ang 1.57) zx nil
        )
      )
      (princ "\n你没有点取直线，请重新选择直线!")
    )
  )
  (while txt     
    (if (setq sn (car (entsel "\n选择文字:")))
      (if (= (to 0) "TEXT")
        (setq en (entget sn) dq (to 72) txt nil
              n (if (= dq 0) 10 11) p1 (to 10) p2 (to 11)
              h (to 40) dh (* h 0.2) p0 (polar pmid a0 dh)
              en (subst (cons 72 1) (assoc 72 en) en)
              en (subst (cons 11 p0) (assoc 11 en) en)
              en (subst (cons 50 ang) (assoc 50 en) en)
        )
        (princ "\n你点取的不是文字，请重新选择文字!")
      )
      (princ "\n你没有点取文字，请重新选择文字!")
    )      
  )
  (entmod en)
  (command "undo" "e")
  (princ)
)       [/PHP]

zhongyang730

不错 ，谢谢了，

lin020202

怎么下载不了？

yuzb1314

这个好。谢谢提供

zhd81617

请14楼楼主直接把源码贴上,方便共享.
谢谢!


14楼楼主说：   9pt 10pt 11pt 12pt 13pt 15pt  

zxdz(字线对正):


上传的附件 zxdz(字线对正).rar (大小:1.34 KB,18次下载)

下载提示：
点此查看:爱心币规则
左键单击链接使用浏览器下载.否则可能下载到错误文件.两次下载时间间隔由你的日均在线时间决定.
对于多卷压缩文件，下载时请将文件名下划线（包括下划线）前面的数字前缀去掉，保留后面的文件名即可，否则不能正确解开压缩.
FTP服务器限制一个IP地址登陆，请下载完一个文件后，再开始点击下载其他文件.
如果你在局域网内，如果不能下载，请联系你们网管开放FTP端口.

石井鱼

为什么下载时候网页每次都打不开，下不了

gysjy

最初由 石井鱼 发布
[B]为什么下载时候网页每次都打不开，下不了 [/B]

点“拷贝到剪切板”，打开一个空白文档，粘贴剪切板的内容，存储为lsp文件即可。

zcenc

在标注的时候有点用处

海岛清商

谢谢楼主了,非常好用的一个小工具了!

hnxychf

zxdz.lsp下载不了

jiyi20099

这个程序怎么运用呀！！