【e派】工具箱函数再揭秘及应用实例

寒潮大冬瓜

院长好！我用“(xyp-SubUpd ss 41 st41)”函数来缩放属性cass块，普通块没问题，只是这个cass属性高程点块的文字没变化，期待院长指导指导……

xyp1964

寒潮大冬瓜 发表于 2024-6-19 19:57
院长好！我用“(xyp-SubUpd ss 41 st41)”函数来缩放属性cass块，普通块没问题，只是这个cass属性高程点块 ...

1. (defun c:tt ()
   
2.   (if (and (setq s0 (car (entsel "\n选择参照图块: ")))
   
3.            (setq ss (ssget '((0 . "INSERT"))))
   
4.       )
   
5.     (progn
   
6.       (setq d41 (xyp-DXF 41 s0)
   
7.             i -1
   
8.       )
   
9.       (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.         (setq d41a (xyp-DXF 41 s1)
    
11.               sc (/ d41 d41a  1.)
    
12.         )
    
13.         (xyp-ScaleEntity s1 (xyp-DXF 10 s1) sc)
    
14.       )
    
15.     )
    
16.   )
    
17.   (princ)
    
18. )

(defun c:tt ()<br />   (if (and (setq s0 (car (entsel "\n选择参照图块: ")))<br />            (setq ss (ssget '((0 . "INSERT"))))<br />       )<br />     (progn<br />       (setq d41 (xyp-DXF 41 s0)<br />             i -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq d41a (xyp-DXF 41 s1)<br />               sc (/ d41 d41a  1.)<br />         )<br />         (xyp-ScaleEntity s1 (xyp-DXF 10 s1) sc)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

寒潮大冬瓜

xyp1964 发表于 2024-6-19 22:44

感谢院长指导！
;【e派】工具箱函数再揭秘及应用实例
;http://bbs.mjtd.com/forum.php?mo ... 5673&fromuid=418631
;(出处: 明经CAD社区)
;
;xyp1964发表于 2024-6-19 22:44 | 只看该作者
;寒潮大冬瓜 发表于 2024-6-19 19:57
;院长好！我用“(xyp-SubUpd ss 41 st41)”函数来txyp2024-6-19缩放属性cass块普通块xyp1964于2024-6-19没问题，只是这个cass属性高程点块 ...
;txyp2024-6-19缩放属性cass块普通块xyp1964于2024-6-19
(defun c:txyp2024-6-19()
        (if(and(setq s0(car(entsel "\n选择参照图块: ")))
       (setq ss(ssget '((0 . "INSERT"))))
                       )
    (progn
                        (setq d41(xyp-DXF 41 s0)
                                            i -1
                              )
                        (while(setq s1(ssname ss(setq i(1+ i))))
                                (setq d41a(xyp-DXF 41 s1)
                                                      sc(/ d41 d41a  1.)
                                        )
                                (xyp-ScaleEntity s1(xyp-DXF 10 s1) sc)
                              )
                    )
          )
        (princ)
)
;没有最好，只有更好！e派系统(XCAD)QQ群下载：24942984

命令: (progn (load "C:/XCAD/txyp2024-6-19缩放属性cass块普通块xyp1964于2024-6-19.lsp")(princ))
Error: undefined function - ENTSEL?
可能是我的XCAD版本没更新，还没有“ ENTSEL”这个函数

yerenyi

无条件顶，院长的源码那是必须学习滴

nuan1989

厉害

寒潮大冬瓜

院长好！辛苦指导一下这个“RENAME”命令的插件，为何实现不了？
;求rename命令增强版
;http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631
;(出处: 明经CAD社区)
renall增强版rename命令andyding于2023-7-4明经

寒潮大冬瓜

院长好！我用XYP-DXF1964和xyp-MkLaCo函数整了个获取起点10的坐标继续画线的代码,辛苦院长指导
感觉还不够顺……
;FX获取直线圆块样条曲线多段线等图元10起点画线XYP-DXF1964和xyp-MkLaCo函数
(defun c:FX(/ k e i p pp s)
        (setq k(car(entsel)))
        (setq p(xyp-DXF1964 10 K))
        (setq kTCM0(xyp-DXF1964 8 K))
        (SETQ kTCM(strcat kTCM0 "FX-" (menucmd "M=$(edtime,$(getvar,date),YYYYMODDhh)") ))
        (xyp-MkLaCo kTCM 2)
        (COMMAND "LINE" p PAUSE "")
        (setvar "CMDECHO" 1)
)

xyp1964

寒潮大冬瓜 发表于 2024-8-18 00:30
院长好！我用XYP-DXF1964和xyp-MkLaCo函数整了个获取起点10的坐标继续画线的代码,辛苦院长指导
感觉 ...

1. (defun c:tt ()
   
2.   (while (setq e (car (entsel"\n选择实体: <退出>")))
   
3.        (setq a (menucmd "M=$(edtime,$(getvar,date),YYYYMODDhh)"))
   
4.       (xyp-MkLaCo (strcat (xyp-DXF 8 e) "-FX-" a) 2)
   
5.       (COMMAND "LINE" (xyp-DXF 10 e) pause "")
   
6.    )
   
7.   (princ)
   
8. )

(defun c:tt ()<br />   (while (setq e (car (entsel"\n选择实体: <退出>")))<br />        (setq a (menucmd "M=$(edtime,$(getvar,date),YYYYMODDhh)"))<br />       (xyp-MkLaCo (strcat (xyp-DXF 8 e) "-FX-" a) 2)<br />       (COMMAND "LINE" (xyp-DXF 10 e) pause "")<br />    )<br />   (princ)<br /> )

寒潮大冬瓜

xyp1964 发表于 2024-8-19 11:28

感谢院长！

xyp1964

1. ;; xyp-9Pt 实体或选择集9点坐标 (xyp-9Pt ename site)
   
2. (defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8 i p1a p9a s1 x ob mid)
   
3.   (defun mid (p1 p2)
   
4.     (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))
   
5.   )
   
6.   (cond ((= (type ename) 'ENAME)
   
7.          (vla-getboundingbox (vlax-ename->vla-object ename) 'MinPT 'MaxPT)
   
8.          (setq p1 (vlax-safearray->list MinPT)
   
9.                p9 (vlax-safearray->list MaxPT)
   
10.          )
    
11.         )
    
12.         ((= (type ename) 'VLA-OBJECT)
    
13.          (vla-getboundingbox ename 'MinPT 'MaxPT)
    
14.          (setq p1 (vlax-safearray->list MinPT)
    
15.                p9 (vlax-safearray->list MaxPT)
    
16.          )
    
17.         )
    
18.         ((= (type ename) 'PICKSET)
    
19.          (setq i   -1
    
20.                p1a '()
    
21.                p9a '()
    
22.          )
    
23.          (while  (setq s1 (ssname ename (setq i (1+ i))))
    
24.            (setq ob (vlax-ename->vla-object s1))
    
25.            (vla-getboundingbox ob 'MinPT 'MaxPT)
    
26.            (setq p1  (vlax-safearray->list MinPT)
    
27.                  p9  (vlax-safearray->list MaxPT)
    
28.                  p1a (cons p1 p1a)
    
29.                  p9a (cons p9 p9a)
    
30.            )
    
31.          )
    
32.          (setq p1 (apply 'mapcar (cons 'min p1a))
    
33.                p9 (apply 'mapcar (cons 'max p9a))
    
34.          )
    
35.         )
    
36.   )
    
37.   (setq p5 (mid p1 p9)
    
38.         p3 (if (< (car p9) (car p1))
    
39.              (list (car p1) (cadr p9) (caddr p1))
    
40.              (list (car p9) (cadr p1) (caddr p1))
    
41.            )
    
42.         p7 (if (< (car p9) (car p1))
    
43.              (list (car p9) (cadr p1) (caddr p9))
    
44.              (list (car p1) (cadr p9) (caddr p9))
    
45.            )
    
46.         p2 (mid p1 p3)
    
47.         p4 (mid p1 p7)
    
48.         p6 (mid p3 p9)
    
49.         p8 (mid p7 p9)
    
50.   )
    
51.   (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
    
52. )

;; xyp-9Pt 实体或选择集9点坐标 (xyp-9Pt ename site)<br /> (defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8 i p1a p9a s1 x ob mid)<br />   (defun mid (p1 p2)<br />     (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))<br />   )<br />   (cond ((= (type ename) 'ENAME)<br />          (vla-getboundingbox (vlax-ename->vla-object ename) 'MinPT 'MaxPT)<br />          (setq p1 (vlax-safearray->list MinPT)<br />                p9 (vlax-safearray->list MaxPT)<br />          )<br />         )<br />         ((= (type ename) 'VLA-OBJECT)<br />          (vla-getboundingbox ename 'MinPT 'MaxPT)<br />          (setq p1 (vlax-safearray->list MinPT)<br />                p9 (vlax-safearray->list MaxPT)<br />          )<br />         )<br />         ((= (type ename) 'PICKSET)<br />          (setq i   -1<br />                p1a '()<br />                p9a '()<br />          )<br />          (while  (setq s1 (ssname ename (setq i (1+ i))))<br />            (setq ob (vlax-ename->vla-object s1))<br />            (vla-getboundingbox ob 'MinPT 'MaxPT)<br />            (setq p1  (vlax-safearray->list MinPT)<br />                  p9  (vlax-safearray->list MaxPT)<br />                  p1a (cons p1 p1a)<br />                  p9a (cons p9 p9a)<br />            )<br />          )<br />          (setq p1 (apply 'mapcar (cons 'min p1a)) <br />                p9 (apply 'mapcar (cons 'max p9a))<br />          )<br />         )<br />   )<br />   (setq p5 (mid p1 p9)<br />         p3 (if (< (car p9) (car p1))<br />              (list (car p1) (cadr p9) (caddr p1))<br />              (list (car p9) (cadr p1) (caddr p1))<br />            )<br />         p7 (if (< (car p9) (car p1))<br />              (list (car p9) (cadr p1) (caddr p9))<br />              (list (car p1) (cadr p9) (caddr p9))<br />            )<br />         p2 (mid p1 p3)<br />         p4 (mid p1 p7)<br />         p6 (mid p3 p9)<br />         p8 (mid p7 p9)<br />   )<br />   (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))<br /> )