哪位大神有时间帮我把这个lsp增加一个复制功能在里面啊

wline · 发表于 2024-7-12 15:36:28

东西是在明经上面找的。好久之前的东西找不到原来的作者了，麻烦各位大神了
插件是可以动态对齐线的，但是没有复制功能，用起来始终要复杂很多，谢谢
;;;功能：通用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)
)

czb203 · 发表于 2024-7-12 17:01:01

看不懂，你要什么效果~

bai2000 · 发表于 2024-7-12 17:11:24

我想是：先复制文字，再把文字齐线

wline · 发表于 2024-7-12 17:53:59

czb203 发表于 2024-7-12 17:01
看不懂，你要什么效果~

这个插件可以让文字平行线，我想要的是复制一个文字出来平行于线，而不是把文字拖走平行于线

wline · 发表于 2024-7-12 17:55:06

bai2000 发表于 2024-7-12 17:11
我想是：先复制文字，再把文字齐线

大佬，就是这个意思，麻烦帮我改下，我自己试了下，完全没这个水平

kozmosovia · 发表于 2024-7-12 18:07:29

  (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

wline · 发表于 2024-7-12 21:46:28

kozmosovia 发表于 2024-7-12 18:07
(setq EN_TEXT (car SS))
(setq ENT_TEXT (entget EN_TEXT))
(wcmatch (cdr (assoc 0 ...

厉害了大神，寥寥几字，就搞定了

moranyuyan · 发表于 2024-7-31 16:14:28

程序执行过程中，提示文字滞后，需要修复。

moranyuyan · 发表于 2024-7-31 16:37:31

kozmosovia 发表于 2024-7-12 18:07
(setq EN_TEXT (car SS))
(setq ENT_TEXT (entget EN_TEXT))
(wcmatch (cdr (assoc 0 ...

程序执行过程中，提示文字滞后，能修复下吗

账号		自动登录	找回密码
密码			注册

[提问] 哪位大神有时间帮我把这个lsp增加一个复制功能在里面啊

本帖子中包含更多资源