【求助】如何多个同名块基点，批量插入图元

ferious

【求助】如何在一个同名块的一个固定位置基点，批量插入多个文字或者其他图元。如图下：

ssyfeng

求出文字插入点在当前块插入点的相对位置，再求其它块文字的相对位置，复制一下就行啦
或者直接把这个文字放到块里面，更简单

vitalgg

https://www.ixigua.com/7156226718376657438?utm_source=xiguastudio

从3分25秒开始

ferious

ssyfeng 发表于 2024-3-13 11:31
求出文字插入点在当前块插入点的相对位置，再求其它块文字的相对位置，复制一下就行啦
或者直接把这个文字 ...

有没有类似代码？

ferious

vitalgg 发表于 2024-3-13 12:06
https://www.ixigua.com/7156226718376657438?utm_source=xiguastudio

从3分25秒开始

感谢大师不吝笔墨

ferious

vitalgg 发表于 2024-3-13 12:06
https://www.ixigua.com/7156226718376657438?utm_source=xiguastudio

从3分25秒开始

大师，有没有源码借鉴的？

vitalgg

ferious 发表于 2024-3-15 14:15
大师，有没有源码借鉴的？

https://gitee.com/vitalmm/at-pm/blob/main/sign.lsp

以前写的，代码组织结构有点乱

ferious

vitalgg 发表于 2024-3-15 18:07
https://gitee.com/vitalmm/at-pm/blob/main/sign.lsp

以前写的，代码组织结构有点乱

有很多自定义函数，
有没有成品的主函数？

vitalgg

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

1. ;; 加载 @lisp 函数库
   
2. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
3. 
   
4. (defun c:cbb ()
   
5.   (@:prompt (string:from-list  '("只支持xyz轴缩放值相同的块,如果不同仅考虑X轴的缩放。"
   
6.             "操作步骤："
   
7.             "1、选中要复制的图形，"
   
8.             "2、选择源块"
   
9.             "3、选择一个或多个目标块"
   
10.             ) "\n"))
    
11.   (@:prompt "请选择要复制的图形:")
    
12.   (setq ents(pickset:to-list (ssget)))
    
13.   (@:prompt "请选择源块:")
    
14.   (setq blk-src(car (pickset:to-list(ssget ":E:S" '((0 . "insert"))))))
    
15.   (@:prompt "请选择目标块:")
    
16.   (if (eq (vla-get-isdynamicblock (e2o blk-src)) :vlax-true)
    
17.       (progn
    
18.         (setq blk-targets
    
19.               (vl-remove-if-not
    
20.                (function(lambda(x)
    
21.                           (eq
    
22.                            (vla-get-effectivename (e2o x))
    
23.                            (vla-get-effectivename (e2o blk-src)))))
    
24.                (pickset:to-list
    
25.                 (ssget (list '(0 . "insert")
    
26.                              (cons 2 (strcat (entity:getdxf blk-src 2)
    
27.                                              ",`**"))
    
28.                              ))))))
    
29.     (setq blk-targets
    
30.           (pickset:to-list
    
31.            (ssget (list '(0 . "insert")
    
32.                         (cons 2 (entity:getdxf blk-src 2)))))))
    
33.    
    
34.   (setq pt-base (entity:getdxf blk-src 10))
    
35.   (setq rotate-base (entity:getdxf blk-src 50))
    
36.   (setq scale-base (entity:getdxf blk-src 41));; '(41 42 43)))
    
37.   ;; 计算
    
38.   ;; 生成新图形
    
39.   (foreach
    
40.    blk-target blk-targets
    
41.    (setq pt-target (entity:getdxf blk-target 10))
    
42.    (setq rotate-target (entity:getdxf blk-target 50))
    
43.    (setq scale-target (entity:getdxf blk-target 41));; '(41 42 43)))
    
44.    (mapcar
    
45.     '(lambda(x)
    
46.        (vla-move x (point:to-ax pt-base)
    
47.                  (point:to-ax pt-target))
    
48.        (vla-scaleentity x (point:to-ax pt-target)
    
49.                   (/ scale-target scale-base))
    
50.        (vla-rotate x (point:to-ax pt-target)
    
51.                    (- rotate-target rotate-base)))
    
52.     (mapcar 'vla-copy (mapcar 'e2o ents)))
    
53.    ))
    

;; 加载 @lisp 函数库<br /> (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> <br /> (defun c:cbb ()<br />   (@:prompt (string:from-list  '("只支持xyz轴缩放值相同的块,如果不同仅考虑X轴的缩放。"<br />             "操作步骤："<br />             "1、选中要复制的图形，"<br />             "2、选择源块"<br />             "3、选择一个或多个目标块"<br />             ) "\n"))<br />   (@:prompt "请选择要复制的图形:")<br />   (setq ents(pickset:to-list (ssget)))<br />   (@:prompt "请选择源块:")<br />   (setq blk-src(car (pickset:to-list(ssget ":E:S" '((0 . "insert"))))))<br />   (@:prompt "请选择目标块:")<br />   (if (eq (vla-get-isdynamicblock (e2o blk-src)) :vlax-true)<br />       (progn <br />         (setq blk-targets<br />               (vl-remove-if-not<br />                (function(lambda(x)<br />                           (eq<br />                            (vla-get-effectivename (e2o x))<br />                            (vla-get-effectivename (e2o blk-src)))))<br />                (pickset:to-list<br />                 (ssget (list '(0 . "insert")<br />                              (cons 2 (strcat (entity:getdxf blk-src 2)<br />                                              ",`**"))<br />                              ))))))<br />     (setq blk-targets<br />           (pickset:to-list<br />            (ssget (list '(0 . "insert")<br />                         (cons 2 (entity:getdxf blk-src 2)))))))<br />    <br />   (setq pt-base (entity:getdxf blk-src 10))<br />   (setq rotate-base (entity:getdxf blk-src 50))<br />   (setq scale-base (entity:getdxf blk-src 41));; '(41 42 43)))<br />   ;; 计算<br />   ;; 生成新图形<br />   (foreach<br />    blk-target blk-targets<br />    (setq pt-target (entity:getdxf blk-target 10))<br />    (setq rotate-target (entity:getdxf blk-target 50))<br />    (setq scale-target (entity:getdxf blk-target 41));; '(41 42 43)))<br />    (mapcar<br />     '(lambda(x)<br />        (vla-move x (point:to-ax pt-base)<br />                  (point:to-ax pt-target))<br />        (vla-scaleentity x (point:to-ax pt-target)<br />                   (/ scale-target scale-base))<br />        (vla-rotate x (point:to-ax pt-target)<br />                    (- rotate-target rotate-base)))<br />     (mapcar 'vla-copy (mapcar 'e2o ents)))<br />    ))<br />

ferious

vitalgg 发表于 2024-3-16 05:53

感谢大师，这个要VIP的吗？