是否能写出这样的代码？

michaelbomo

我想批量在鼠标框选的每个直线段的中点插入块，块的方向要顺着直线方向作自动调整，求这样的代码，谢谢！

vitalgg

2. (defun mb ()
   
3.   (if
   
4.     (setq blk (ui:select
   
5.                 "block name "
   
6.                 (vl-remove-if
   
7.                   '(lambda (x) (= "*" (substr x 1 1)))
   
8.                   (tbl:list "block")
   
9.                 )))
   
10.     (progn
    
11.       (setq lines (pickset:to-list (ssget '((0 . "line")))))
    
12.       (foreach line lines
    
13.         (block:insert
    
14.           blk
    
15.           ""
    
16.           (line:mid line)
    
17.           (apply 'angle (curve:get-points line))
    
18.           1
    
19.         )))))

(defun mb () <br />   (if <br />     (setq blk (ui:select <br />                 "block name "<br />                 (vl-remove-if <br />                   '(lambda (x) (= "*" (substr x 1 1)))<br />                   (tbl:list "block")<br />                 )))<br />     (progn <br />       (setq lines (pickset:to-list (ssget '((0 . "line")))))<br />       (foreach line lines <br />         (block:insert <br />           blk<br />           ""<br />           (line:mid line)<br />           (apply 'angle (curve:get-points line))<br />           1<br />         )))))

如果无法播放，请点击此处在新窗口打开

guosheyang

块儿的方向 具体是指的啥？

liuhe

2. (DEFUN C:TT (/ e1 ss i ent p10 p11 i)
   
3.   (defun MID (po1 po2)
   
4.     (setq po (MAPCAR '(lambda (X Y) (* (+ X Y) 0.5)) po1 po2))
   
5.   )
   
6.   (SETQ        E1 (CDR        (ASSOC 2 (ENTGET (CAR (ENTSEL "选择需要插入的块"))))
   
7.                 SS        (SSGET '((0 . "LINE")))
   
8.                 I        0
   
9.            )
   
10.   )
    
11.   (IF (AND SS E1)
    
12.     (REPEAT (SSLENGTH SS)
    
13.       (SETQ ENT        (SSNAME SS I)
    
14.             P10        (CDR (ASSOC 10 (ENTGET ENT)))
    
15.             P11        (CDR (ASSOC 11 (ENTGET ENT)))
    
16.             P1        (MID P10 P11)
    
17.       )
    
18.       (entmake (list '(0 . "INSERT")
    
19.                      (cons 2 E1)
    
20.                      (cons 10 p1)
    
21.                      (cons 50 (ANGLE P10 P11))
    
22.                )
    
23.       )
    
24.       (SETQ I (1+ I))
    
25.     )
    
26.   )
    
27. )
    

(DEFUN C:TT (/ e1 ss i ent p10 p11 i)<br />   (defun MID (po1 po2)<br />     (setq po (MAPCAR '(lambda (X Y) (* (+ X Y) 0.5)) po1 po2))<br />   )<br />   (SETQ        E1 (CDR        (ASSOC 2 (ENTGET (CAR (ENTSEL "选择需要插入的块"))))<br />                 SS        (SSGET '((0 . "LINE")))<br />                 I        0<br />            )<br />   )<br />   (IF (AND SS E1)<br />     (REPEAT (SSLENGTH SS)<br />       (SETQ ENT        (SSNAME SS I)<br />             P10        (CDR (ASSOC 10 (ENTGET ENT)))<br />             P11        (CDR (ASSOC 11 (ENTGET ENT)))<br />             P1        (MID P10 P11)<br />       )<br />       (entmake (list '(0 . "INSERT")<br />                      (cons 2 E1)<br />                      (cons 10 p1)<br />                      (cons 50 (ANGLE P10 P11))<br />                )<br />       )<br />       (SETQ I (1+ I))<br />     )<br />   )<br /> )<br />

liuhe

vitalgg 发表于 2023-3-15 17:14

6666666666

michaelbomo

vitalgg 发表于 2023-3-15 17:14

Error: undefined function - TBLIST

vitalgg

michaelbomo 发表于 2023-8-17 12:32
Error: undefined function - TBLIST

视频右下角网址安装相关的 函数库。