在li的中点插入块

Miller87 · 发表于 2022-7-5 19:51:46

早上好，我需要一个lisp，它可以自动在预定长度的每个特定行的中点插入一个块。

我在图纸中创建了几个块，称为：
-“50m”->插入500 mm直线的中点
-“100m”->插入1000 mm线的中点。
ecc。。
我写了这个粗糙的代码


(defun C:blockparlines (/)
 (setq s (ssget "x" '((0 . "LINE" ))))
;FILTER SELECTION FOR LINES WITH LENGTH 500 mm
(setq ss1 (ssadd))
(setq lung 500)
(setq ss2 s)
(if ss2 (progn
(setq i 0  ssl (sslength ss2))
(repeat ssl
 (setq ename (ssname ss2 i))
 (setq ll (distance (cdr (assoc 10 (entget ename))) (cdr (assoc 11 (entget ename)))))
 (if (= lung ll)(ssadd ename ss1))
 (setq i (1+ i))
 )
(princ (strcat (itoa (sslength ss1)) " generated block's of 500 mm."))
;(sssetfirst nil ss1)
))
(princ)
;INSERT BLOCK IN MIDPOINT of 500 mm
(setq name "50M")
(repeat (setq i (sslength ss1))
      (setq e (entget (ssname ss1 (setq i (1- i)))))
      (entmakex
        (list '(0 . "INSERT")
              (cons 10
                    (mapcar (function (lambda (q p) (/ (+ q p) 2.)))
                            (setq p1 (cdr (assoc 10 e)))
                            (setq p2 (cdr (assoc 11 e)))
                    )
              )
              (cons 2 name)
              (cons 50 (angle p1 p2))
              '(41 . 1.0)
              '(42 . 1.0)
              '(43 . 1.0)
        )
      )
)
(princ)
;RESET SS1 
 (setq ss1 nil)
 (setq ss1 (ssadd))
;FILTER SELECTION FOR LINES WITH LENGTH 1000 mm
(setq lung 1000)
(setq ss2 s)
(if ss2 (progn
(setq i 0  ssl (sslength ss2))
(repeat ssl
 (setq ename (ssname ss2 i))
 (setq ll (distance (cdr (assoc 10 (entget ename))) (cdr (assoc 11 (entget ename)))))
 (if (= lung ll)(ssadd ename ss1))
 (setq i (1+ i))
 )
(princ (strcat (itoa (sslength ss1)) " generated block's of 1000 mm."))
(sssetfirst nil ss1)
))
(princ)
;INSERT BLOCK IN MIDPOINT of 1000 mm
(setq name "100M")
(repeat (setq i (sslength ss1))
      (setq e (entget (ssname ss1 (setq i (1- i)))))
      (entmakex
        (list '(0 . "INSERT")
              (cons 10
                    (mapcar (function (lambda (q p) (/ (+ q p) 2.)))
                            (setq p1 (cdr (assoc 10 e)))
                            (setq p2 (cdr (assoc 11 e)))
                    )
              )
              (cons 2 name)
              (cons 50 (angle p1 p2))
              '(41 . 1.0)
              '(42 . 1.0)
              '(43 . 1.0)
        )
      )
)
(princ)
;RESET SS1 
 (setq ss1 nil)
 (setq ss1 (ssadd))
 )

以下是错误：
-它没有考虑沿XZ-YZ平面的线？我不明白为什么。
-这是一段很长的代码，我需要按长度插入10个或更多的块。优化例程的简单方法？

谢谢
米勒

Tharwat · 发表于 2022-7-5 20:00:40

你能列出其余的区块名及其相关长度吗？

Miller87 · 发表于 2022-7-5 20:01:29

要在线路上关联的块列表：
长度为500 mm的线路中点处的“50M”->
长度为1000 mm的线路中点处的“100M”->
长度为1500 mm的线路中点处的“150M”->
长度为2000 mm的线路中点处的“200M”->
长度为2500 mm的线路中点处的“250M”->
长度为3000 mm的线路中点处的“300M”->

Tharwat · 发表于 2022-7-5 20:06:51

试试这个，让我知道。

[未测试]

copy


(defun c:Test  (/ l ss)
 ;;;        Tharwat 27.4.2015        ;;;
 (setq l '(("50M" 500)
           ("100M" 1000)
           ("150M" 1500)
           ("200M" 2000)
           ("250M" 2500)
           ("300M" 3000))
       )
 (if (setq ss (ssget '((0 . "LINE"))))
   ((lambda (i / sn a b f)
      (while (setq sn (ssname ss (setq i (1+ i))))
        (if
          (and (vl-some
                 '(lambda (x)
                    (equal
                      (distance
                        (setq a (cdr (assoc 10 (entget sn))))
                        (setq b (cdr (assoc 11 (entget sn)))))
                      (cadr (setq f x))
                      1e-)
                 l)
               (tblsearch "BLOCK" (car f))
               )
           (entmake (list '(0 . "INSERT")(cons 10 (mapcar (function (lambda (q p) (/ (+ q p) 2.)))
                                                          a
                                                          b
                                                          ))
                          (cons 2 (car f))
                          (cons 50 (angle a b))
                          '(41 . 1.0)
                          '(42 . 1.0)
                          '(43 . 1.0)
                          )
                    ))))  -1)
   )
 (princ)
 )