悬赏缩放LISP源码

qianzj

7#不错啊                              

flytoday

x_s_s_1 哥能不能将指定图层名改成选择识别那会通用了，。。。

xyp1964

没有源码，只有演示就算了

xyp1964

属于对垃圾图的处理，伪源码就不发了

随梦而飞

测试图一

1、我的邮箱  1980006156qq.com
2、由于本人刚学LISP,请高手注明每行LISP语言的简要的说明性文字，方便我认真学一下，如有这个的教学更佳。
3、请提供联系方式在我的邮箱，以便悬赏到位，千万别不好意思，否则我会不安的。

4、轴线不缩放，缩放后标注尺寸数字不变。

5、源码适用CAD2006

6、支持批量选择

7、关于缩放比例，只要用标注量一下不是原位大样图，就知道了，如Z1，图中有原位大样图，还有Z1不是原位大样图


目的是将原位大样图缩成不是原位大样图

xiaodao520

x_s_s_1 发表于 2012-8-3 18:41
严正声明！！子函数均来自明经，非本人原创，尺寸的比例由于不知道个人习惯没有处理

不知道什么原因，在几台电脑上试了，均不成功。x_s_s_1

lpl

x_s_s_1 发表于 2012-8-3 21:30
看来还要加一句啊，这个东西本来就是copy别人改的，本人从来不改别人函数名及变量名！！我也没说自己编 ...

提示; 错误: 参数类型错误: lselsetp nil，不能使用，请完善。

x_s_s_1

xiaodao520 发表于 2012-8-4 07:45
不知道什么原因，在几台电脑上试了，均不成功。x_s_s_1

请注意图层，要选中轴线图层中的图元才行，没时间改版，下面是针对测试图的

2. 
   
3. (vl-load-com)
   
4. ;;;lst_ssn函数(lst_ssn ss)
   
5. ;;;ss参数：选折集
   
6. ;;;返回图元名表
   
7. (defun lst_ssn (ss / n lst)
   
8.   (repeat (setq N (sslength ss))
   
9.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
   
10.   ) ;_ 结束repeat
    
11. ) ;_ 结束defun
    
12. ;;;计算曲线交点
    
13. (defun Curveinters (en1 en2 / pl pts)
    
14.   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
    
15.   (while pl
    
16.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
    
17.    pl (cdr (cdr (cdr pl)))
    
18.    )
    
19.     )
    
20. pts
    
21.   )
    
22. (defun zsf (/ ss_all ss_dot ss_sc ss_pts pt ssets scal x objss )
    
23.   (setvar "cmdecho" 0)
    
24.   (prompt "\n请选择需要进行缩放的物体:")   
    
25.   (setq ss_all (ssget));此处可根据个人习惯增加图层(ssget  '((8 . "colu,dim,sbar,dote,axis")))
    
26.   (setq ss_dot (ssget "p" '((0 . "*line") (8 . "轴线__点划线"))));此处图层根据个人习惯改
    
27.   (command "._Select" ss_all "remove" ss_dot "")
    
28.   (setq ss_sc (ssget "p"))
    
29.   (setq ss_pts (lst_ssn ss_dot))
    
30.   (setq pt (car(Curveinters (car ss_pts) (cadr ss_pts))))
    
31.   (setq ssets (lst_ssn ss_sc))
    
32.   (if (setq scal (getreal "\n比例因子<0.25>:"))
    
33.     t
    
34.     (setq scal 0.25))
    
35.   (foreach x ssets  
    
36.     (setq objss (vlax-ename->vla-object x))  
    
37.     (vla-scaleentity objss (vlax-3D-point pt) scal)
    
38.   )  
    
39. )
    
40. (defun c:scc ()  
    
41.   (zsf)  
    
42.   (princ)  
    
43. )
    

<br /> (vl-load-com)<br /> ;;;lst_ssn函数(lst_ssn ss)<br /> ;;;ss参数：选折集<br /> ;;;返回图元名表<br /> (defun lst_ssn (ss / n lst)<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   ) ;_ 结束repeat<br /> ) ;_ 结束defun<br /> ;;;计算曲线交点<br /> (defun Curveinters (en1 en2 / pl pts)<br />   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))<br />   (while pl<br />     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))<br />    pl (cdr (cdr (cdr pl)))<br />    )<br />     )<br /> pts<br />   )<br /> (defun zsf (/ ss_all ss_dot ss_sc ss_pts pt ssets scal x objss )<br />   (setvar "cmdecho" 0)<br />   (prompt "\n请选择需要进行缩放的物体:")    <br />   (setq ss_all (ssget));此处可根据个人习惯增加图层(ssget  '((8 . "colu,dim,sbar,dote,axis")))<br />   (setq ss_dot (ssget "p" '((0 . "*line") (8 . "轴线__点划线"))));此处图层根据个人习惯改<br />   (command "._Select" ss_all "remove" ss_dot "")<br />   (setq ss_sc (ssget "p"))<br />   (setq ss_pts (lst_ssn ss_dot))<br />   (setq pt (car(Curveinters (car ss_pts) (cadr ss_pts))))<br />   (setq ssets (lst_ssn ss_sc))<br />   (if (setq scal (getreal "\n比例因子<0.25>:"))<br />     t<br />     (setq scal 0.25)) <br />   (foreach x ssets  <br />     (setq objss (vlax-ename->vla-object x))  <br />     (vla-scaleentity objss (vlax-3D-point pt) scal) <br />   )  <br /> )<br /> (defun c:scc ()  <br />   (zsf)  <br />   (princ)  <br /> ) <br />

lpl

x_s_s_1 发表于 2012-8-4 08:49
请注意图层，要选中轴线图层中的图元才行，没时间改版，下面是针对测试图的

建议改改，使其具备通用性。标注大小缩放，轴线图层可以任意选择。

x_s_s_1

lpl 发表于 2012-8-4 10:07
建议改改，使其具备通用性。标注大小缩放，轴线图层可以任意选择。

增加了通用性就增加了几个变量，几个回车，个人可根据自己的喜好去改，个人用的东西，考虑那么多通用干什么