沿放置属性块乐筑天下 - Powered by Discuz! Archiver

Tharwat 发表于 2022-7-5 17:53:14

这真让人筋疲力尽

试试看，让我知道。

(defun c:Test (/ *error* blk bk atts sp s e l d v km m lng)
;; Tharwat 11.Aug.2016 ;;
(defun *error* (msg)
(if atts
(mapcar 'setvar '(ATTREQ ATTDIA) atts)
)
(and msg
   (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
   (princ (strcat "\nError => " msg))
)
(princ)
)
(setq blk "BLOCO SINALEIRO")
;; Block name
(if (and (tblsearch "BLOCK" blk)
      (princ "\nSelect LWpolyline :")
      (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
      (setq l (vlax-curve-getdistatpoint
               (setq e (ssname s 0))
               (vlax-curve-getendpoint e)
               )
      )
)
(progn
(setq atts (mapcar 'getvar '(ATTREQ ATTDIA))
      sp (vlax-get (vla-get-activelayout
                        (vla-get-activedocument (vlax-get-acad-object))
                     )
                     'Block
            )
      km (if (= (setq lng (length (vl-string->list (rtos l 2 0)))) 3)
               "000"
               (strcat (nth (- lng 3) '("" "00" "0"))
                     (substr (rtos l 2 0) 1 (- lng 3))
               )
            )
      m (if (= lng 3)
               (substr (rtos l 2 2) 1 3)
               (substr (rtos l 2 2) (1+ (- lng 3)) 3)
            )
)
(mapcar 'setvar '(ATTREQ ATTDIA) '(1 0))
(while
   (and (setq d (getdist (strcat "\nSpecify distance less than "
                                 (rtos l 2 2)
                                 " > :"
                        )
               )
         )
         (< d l)
         (/= "" (setq v (getstring t "\nSpecify Attribute Value :")))
         (setq bk (vla-insertblock
                  sp
                  (vlax-3d-point (vlax-curve-getpointatdist e d))
                  blk
                  1.0
                  1.0
                  1.0
                  (+ (* pi 0.5)
                     (angle '(0. 0. 0.)
                              (vlax-curve-getfirstderiv
                              e
                              (vlax-curve-getparamatpoint
                                 e
                                 (vlax-curve-getpointatdist e d)
                              )
                              )
                     )
                  )
                  )
         )
   )
   (mapcar
      '(lambda (a)
         (vla-put-textstring
            a
            (nth (vl-position (vla-get-tagstring a) '("ID" "KM" "M"))
               (list v km m)
            )
         )
      )
      (vlax-invoke bk 'getattributes)
   )
)
)
)
(if (> d l)
(alert "\nLong distance entered !")
)
(*error* nil)
(princ)
)(vl-load-com)

Cezar Barbalho 发表于 2022-7-5 17:57:14

我是激进的塔瓦先生！

但我想当我试图解释自己的时候，我把变量“l”错当成了变量“d”。。。因为变量“d”是距离中的插入点，因此是信息“km XXX+YYY”的来源。。。我试图纠正这一点，但我没有太多的运气。。。对不起，你觉得呢？

Cezar Barbalho 发表于 2022-7-5 18:00:08

我想如果我把SETQ d放在起点上，它会起作用，然后我把球传给SETQ km，m等等。。。你能告诉我我走对了吗？

谢谢

(PROGN (SETQ d (GETDIST
(STRCAT "\nSpecify distance less than " (RTOS l 2 2) " > :")
      )
atts (MAPCAR 'GETVAR '(attreq attdia))
sp (VLAX-GET (VLA-GET-ACTIVELAYOUT
   (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))
)
'block
      )
km (IF (= (SETQ lng (LENGTH (VL-STRING->LIST (RTOS d 2 0)))) 3)
"000"
(IF (< lng 3 (STRCAT (NTH (- 3 lng) '("" "00" "0"))
      (SUBSTR (RTOS d 2 0) 1 (- lng 3))
      )
   )
)
      )
m (IF (= lng 3)
(SUBSTR (RTOS d 2 2) 1 3)
(SUBSTR (RTOS d 2 2) (1+ (- lng 3)) 3)
      )
)
)

Tharwat 发表于 2022-7-5 18:02:10

嗨，塞扎，

没关系，别担心，我会修改代码以满足您的需要，不管您有什么错误。
因此，请将您的需求与我在第11篇文章中发布的最后一个程序进行清楚的比较。

Cezar Barbalho 发表于 2022-7-5 18:07:25

嗨，塔瓦，

与前一个版本相比，我想通过变量“d”打开变量“l”

km (if (= (setq lng (length (vl-string->list (rtos l 2 0)))) 3)
               "000"
               (strcat (nth (- lng 3) '("" "00" "0"))
                     (substr (rtos l 2 0) 1 (- lng 3))
               )
            )
      m (if (= lng 3)
               (substr (rtos l 2 2) 1 3)
               (substr (rtos l 2 2) (1+ (- lng 3)) 3)
            )

我认为这样，属性将显示块插入点的信息。

现在，它显示的是多段线的总长度，而不是块相对于多段线长度的位置。

在我的尝试中，我试图做到这一点，首先我把SETQ“d”放在其他函数之前，然后我收到了关于第n个函数的错误消息，所以我试图理解它，我想我在这里交换消息比阅读一个月学到了更多。我走对了吗？

Tharwat 发表于 2022-7-5 18:11:07

嗨，塞扎，
变量“d”表示距离值，表示实数（十进制数），而不是块位置。

给我举一个例子，用你以前做过的绘图，让我一次修改程序。

Cezar Barbalho 发表于 2022-7-5 18:11:25

嗨，塔瓦，

我希望这张图片能解释我的意思。

Tharwat 发表于 2022-7-5 18:16:48

希望这能像预期的那样起作用，试试看，让我知道；

(defun c:Test (/ *error* blk bk atts sp s e l d v km m lng)
;; Tharwat 11.Aug.2016 ;;
(defun *error* (msg)
(if atts
(mapcar 'setvar '(ATTREQ ATTDIA) atts)
)
(and msg
   (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
   (princ (strcat "\nError => " msg))
)
(princ)
)
(setq blk "BLOCO SINALEIRO")
;; Block name
(if (and (tblsearch "BLOCK" blk)
      (princ "\nSelect LWpolyline :")
      (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
      (setq l (vlax-curve-getdistatpoint
               (setq e (ssname s 0))
               (vlax-curve-getendpoint e)
               )
      )
)
(progn
(setq atts (mapcar 'getvar '(ATTREQ ATTDIA))
      sp (vlax-get (vla-get-activelayout
                        (vla-get-activedocument (vlax-get-acad-object))
                     )
                     'Block
            )
)
(mapcar 'setvar '(ATTREQ ATTDIA) '(1 0))
(while
   (and (setq d (getdist (strcat "\nSpecify distance less than "
                                 (rtos l 2 2)
                                 " > :"
                        )
               )
         )
         (< d l)
         (/= "" (setq v (getstring t "\nSpecify Attribute Value :")))
         (setq km (if
                  (<= (setq lng (length (vl-string->list (rtos l 2 0))))
                        3
                  )
                     "000"
                     (strcat (nth (- lng 3) '("" "00" "0" "" ""))
                           (substr (rtos l 2 0) 1 (- lng 3))
                     )
                  )
               m(if
                  (<= (setq lng (length (vl-string->list (rtos d 2 0))))
                        3
                  )
                     (substr (rtos d 2 2) 1 3)
                     (substr (rtos d 2 2) (1+ (- lng 3)) 3)
                  )
               bk (vla-insertblock
                  sp
                  (vlax-3d-point (vlax-curve-getpointatdist e d))
                  blk
                  1.0
                  1.0
                  1.0
                  (+ (* pi 0.5)
                     (angle '(0. 0. 0.)
                              (vlax-curve-getfirstderiv
                              e
                              (vlax-curve-getparamatpoint
                                 e
                                 (vlax-curve-getpointatdist e d)
                              )
                              )
                     )
                  )
                  )
         )
   )
   (mapcar
      '(lambda (a)
         (vla-put-textstring
            a
            (nth (vl-position (vla-get-tagstring a) '("ID" "KM" "M"))
               (list v km m)
            )
         )
      )
      (vlax-invoke bk 'getattributes)
   )
)
)
)
(if (> d l)
(alert "\nLong distance entered !")
)
(*error* nil)
(princ)
)(vl-load-com)

Cezar Barbalho 发表于 2022-7-5 18:19:46

嗨，塔瓦，

这是可行的，但我发现多段线的长度有一个限制，如果我尝试使用长度超过100公里的多段线，它会冻结程序。
这个问题很容易解决？

Tharwat 发表于 2022-7-5 18:23:06

对不起，这是你第三次谈论与你在这篇帖子的第一篇帖子中提出的不同的问题。
我对这些不同的输入以及你到底想做什么感到困惑。

我在这个帖子上花了太多时间，很抱歉，我无法无休止地继续下去。

页: 1 [2]

乐筑天下's Archiver