社区 › Auto Lisp › 自动布局 LISP

renkor 发表于 2018-8-25 16:00:10

自动布局 LISP

你好，
我一直在寻找一个能够做这么多次的例程。我有一个道路轴，188个块（视口）通过中点与它对齐。但是，逐个进行所有布局是浪费时间。那么，您是否知道一个例程能够通过模板选项卡的配置自动制作所有布局，并定向到相应的UCS视口？

看看这个例子，我希望你理解我的问题。
最好的问候，
丹尼尔。
**** Hidden Message *****

BIGAL 发表于 2022-8-3 10:04:23

你好，伦克，我发现了你的问题，几年后我有了答案。
你当然设法解决了。
但我这样做是作为一种挑战。
(如果我拼错了什么，我很抱歉，我用了谷歌翻译)
(defun c:test (/ a cnt en entg entg_pline lista n num_str p1 p2 pini pins pline pt
             ss1 ss2)
(setvar "cmdecho" 0)
(command ".ucs" "world")
(if (null (tblsearch "layer" "defpoints"))
    (command ".layer" "m" "defpoints" "c" "7" "" "")
)
(if (setq pline (entsel "\nSelect the road axis:"))
    (progn
      (redraw (car pline) 3) ;_highlight object
      (if (setq pini (getpoint
                     "\nSelect a point near the beginning of the road pline: "
                     )
          )
      (progn
          (setq entg_pline (entget (car pline)))
          (setq lista nil)
          (mapcar '(lambda (a)
                     (if (= (car a) 10)
                     (setq lista (cons (cdr a) lista))
                     )
                   )
                  entg_pline
          )
          (if (
            (setq lista (reverse lista))
          )
          (setq ss1 (ssget "f" lista (list (cons '2 "viewport"))))
          (setq cnt (sslength ss1))
          (if (> cnt 0)
            (progn
            (setq n 0)
            (repeat cnt
                (setq entg (entget (setq en (ssname ss1 n))))
                (setq n (1+ n))
                (setq pins (cdr (assoc 10 entg)))
                (setq pt (polar pins (cdr (assoc 50 entg)) 400))
                (setq p1
                     (polar pins (+ (* pi 0.5) (cdr (assoc 50 entg))) 291.7293)
                )
                (setq p2
                     (polar pins (+ (* pi 1.5) (cdr (assoc 50 entg))) 291.7293)
                )
                (setq p2 (polar p2 (cdr (assoc 50 entg)) 844.4204))
                (setq num_str (rtos n 2 0))
                (if (= (strlen num_str) 1)
                  (setq num_str (strcat "0" num_str))
                )
                ;;;_the number is for verification
                ;;;_layer defpoints does not plot
                (entmakex (list (cons 0 "TEXT")
                              (cons 1 num_str)
                              (cons 10 pt)
                              (cons 11 pt)
                              (cons 8 "defpoints")
                              (cons 40 200)
                              (cons 50 (cdr (assoc 50 entg)))
                              (cons 72 1)
                              (cons 73 2)
                        )
                )
                (command ".-layout" "copy" "template" num_str)
                (command ".-layout" "set" num_str)
                (setq
                  ss2 (ssget
                        "x"
                        (list (cons 0 "VIEWPORT") (cons 410 (getvar "ctab")))
                      )
                )
                (vla-put-displaylocked (vlax-ename->vla-object (ssname ss2 0))
                                       :vlax-false
                )
                (command ".mspace")
                (command ".ucs" "ob" en)
                (command ".plan" "")
                (command ".zoom" "w" (trans p1 0 1) (trans p2 0 1))
                (command ".pspace")
                (setvar "tilemode" 1)
            )
            (command ".-layout" "delet" "template")
            )
          )
      )
      )
    )
)
(if pline
    (redraw (car pline) 4) ;_unhighlight object
)
(princ)
)
EDIT (John):添加了代码标记。

mstg007 发表于 2022-8-3 21:54:53

像这样的事情很乐意多说。目前正在为新的dcl进行重写。

BIGAL 发表于 2022-8-4 07:42:10

我有个问题。slj.engenharia怎么会比你的视频执行代码慢这么多？两者都令人印象深刻。干得好。真的很酷。

BIGAL 发表于 2022-8-4 20:05:54

代码执行速度比视频的方式

查看完整版本: 自动布局 LISP