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

lz689706

最初由 gysjy 发布
[B]
点“拷贝到剪切板”，打开一个空白文档，粘贴剪切板的内容，存储为lsp文件即可。 [/B]

“拷贝到剪切板”在那个位置。

gysjy

最初由 lz689706 发布
[B]

“拷贝到剪切板”在那个位置。 [/B]

在程序代码上方有一排黄色字体“拷贝到剪贴板”。
你用普通的“复制”、“粘贴”也可。

xjking007

我想下那个文字递增的可是不知道为什么就是下不了呢.

gysjy

最初由 xjking007 发布
[B]我想下那个文字递增的可是不知道为什么就是下不了呢. [/B]

已发送email，请查收。

zml84

[php]
;;;========================================================
;;;      练习                                             
;;;功能：通用grread研究                                    
;;=================================================
;;  通用grread定义
(defun ZML-GRREAD (LST / TEST TMP MODE VAL TMP2)
    (setq TEST t)
    (while TEST
(setq TMP  (grread 2)
       MODE (car TMP)
       VAL  (cadr TMP)
)
(cond ((= MODE 2)
        (if (and (setq TMP2 (assoc MODE LST))
   (setq TMP2 (cdr TMP2))
   (setq TMP2 (assoc VAL TMP2))
     )
     (eval (cons 'progn (cdr TMP2)))
     ()
        )
       )
       ((setq TMP2 (assoc MODE LST))
        (eval (cons 'progn (cdr TMP2)))
       )
       (t (princ TMP))
)
    )
)
;;;========================================================
;;;文字随线(角度随线的)
(vl-load-com)
(defun C:TT (/ tt-01 tt-02 LST)
    ;;===============
    ;;功能：计算计算距给定点位最近的线上点 和 线上点的前进方位角
    ;;参数：EN_LINE -----线的图元名称
    ;;           PT -----给定点位
    ;;返回：距点最近的线上点 和 线上点的方位角
    (defun TT-01 (EN_LINE PT / OBJ PT1 LST ANG)
;;将图元名转换为 VLA对象
(setq OBJ (vlax-ename->vla-object EN_LINE))
;;距pt最近的曲线上的点pt1
(setq PT1 (vlax-curve-getclosestpointto OBJ PT))
;;pt1点的切线方向矢量
(setq LST (vlax-curve-getfirstderiv
        OBJ
        (vlax-curve-getparamatpoint
     OBJ
     PT1
        )
    )
)
;;计算切线方位角
(setq ANG (atan (/ (cadr LST) (car LST))))
;;返回
(list PT1 ANG)
    )
    ;;===============
    ;;功能：设置文字对象位置及角度
    (defun TT-02 (EN_TEXT PT ANG / ENT)
(setq ENT (entget EN_TEXT))
(setq ENT (subst (cons 10 PT) (assoc 10 ENT) ENT)
       ENT (subst (cons 11 PT) (assoc 11 ENT) ENT)
       ENT (subst (cons 50 ANG) (assoc 50 ENT) ENT)
)
(entmod ENT)

    )
    ;;===============
    (if (and
     ;;
     (setq SS (entsel "\n点取线: "))
     (setq EN_LINE (car SS))
     (setq ENT_LINE (entget EN_LINE))
     (wcmatch (cdr (assoc 0 ENT_LINE))
       "LINE,ARC,LWPOLYLINE,SPLINE"
     )
     ;;
     (setq SS (entsel "\n点取文字: "))
     (setq EN_TEXT (car SS))
     (setq ENT_TEXT (entget EN_TEXT))
     (wcmatch (cdr (assoc 0 ENT_TEXT)) "TEXT,MTEXT")

)
(progn
     (setq LST
       (list '(5
        ;;
        (setq
         TMP
         (TT-01 EN_LINE VAL)
         PT1
         (car TMP)
         ANG
         (cadr TMP)
        )
        ;;
        (TT-02 EN_TEXT VAL ANG)
         (vlax-get-property (vlax-ename->vla-object EN_text) 'InsertionPoint )
        ;;
        (redraw)
        (grdraw VAL PT1 1)
       )
      ;;左击
      '
       (3
        (redraw)
        (setq TEST NIL)
       )
      '(25
        (redraw)
        (setq TEST NIL)
       )
      '(11
        (redraw)
        (setq TEST NIL)
       )
       )
     )
     (ZML-GRREAD LST)
)
    )
    (princ)
)
[/php]
[B]着色显示版：[/B] [/COLOR]  http://zml84.blog.sohu.com/107484330.html

tianquan3

好东西要支持

sunjwwcj

都不错。以前也看过同类的，

ytw_5184

没有爱心币啊

zhangzl

谢谢可以，反斜线有问题

守仁格竹GM

思路非常好

xvter

12第三方斯蒂芬斯蒂芬

1213131

very good ,thanks a lot

yangchao2005090

怎么没见到文件

吴外安放

谢谢版主分享

杨89

正找这样的来写公路的桩号，下来试试，谢谢了