哪位大神有时间帮我把这个lsp增加一个复制功能在里面啊
东西是在明经上面找的。好久之前的东西找不到原来的作者了，麻烦各位大神了插件是可以动态对齐线的，但是没有复制功能，用起来始终要复杂很多，谢谢
;;;功能：通用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:qe (/ 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)
)
:dizzy:看不懂，你要什么效果~ 我想是：先复制文字，再把文字齐线 czb203 发表于 2024-7-12 17:01
看不懂，你要什么效果~
这个插件可以让文字平行线，我想要的是复制一个文字出来平行于线，而不是把文字拖走平行于线 bai2000 发表于 2024-7-12 17:11
我想是：先复制文字，再把文字齐线
大佬，就是这个意思，麻烦帮我改下，我自己试了下，完全没这个水平:'( (setq EN_TEXT (car SS))
(setq ENT_TEXT (entget EN_TEXT))
(wcmatch (cdr (assoc 0 ENT_TEXT)) "TEXT,MTEXT")
)
(progn
(entmake ENT_TEXT)
(setq LST
(list '(5
;;
(setq
TMP kozmosovia 发表于 2024-7-12 18:07
(setq EN_TEXT (car SS))
(setq ENT_TEXT (entget EN_TEXT))
(wcmatch (cdr (assoc 0...
厉害了大神，寥寥几字，就搞定了 程序执行过程中，提示文字滞后，需要修复。 kozmosovia 发表于 2024-7-12 18:07
(setq EN_TEXT (car SS))
(setq ENT_TEXT (entget EN_TEXT))
(wcmatch (cdr (assoc 0...
程序执行过程中，提示文字滞后，能修复下吗
页:
[1]