[LISP程序]：调整对象XY比例

LUCAS

2. 
   
3. ;;;调整对象XY比例
   
4. ;;;程序设计:赖云龙;;;
   
5. ;;;---------------;;;
   
6. (defun C:SCALEXY (/ holdosmode AA PT X Y PT1 PT2 L1 L2)
   
7.   (command "_.undo" "_be")
   
8.   (setq holdosmode (getvar "osmode"))
   
9.   (setvar "osmode" 39)
   
10.   (defun LL ()
    
11.     (setq PT1 (getpoint "\n参考长度基准点: "))
    
12.     (setq PT2 (getpoint PT1 "\n第二点: "))
    
13.     (setq L1 (distance PT1 PT2))
    
14.     (setq PT1 (getpoint "\n新的长度基准点: "))
    
15.     (setq PT2 (getpoint PT1 "\n第二点: "))
    
16.     (setq L2 (distance PT1 PT2))
    
17.   )
    
18.   (while (= AA NIL)
    
19.     (setq AA (ssget))
    
20.   )
    
21.   (setq PT (getpoint "\n基准点 : "))
    
22.   (setq X (getstring "\n<X比例系数>/参考(R) <1>: "))
    
23.   (cond
    
24.     ((= X "")
    
25.      (setq X 1)
    
26.     )
    
27.     ((or (= X "R") (= X "r"))
    
28.      (LL)
    
29.      (setq X (/ L1 L2))
    
30.     )
    
31.     (t
    
32.      (setq X (atof X))
    
33.     )
    
34.   )
    
35.   (setq        Y (getstring (strcat "\n<Y比例系数>/参考(R) <" (rtos X) ">: ")
    
36.           )
    
37.   )
    
38.   (cond
    
39.     ((= Y "")
    
40.      (setq Y 1)
    
41.     )
    
42.     ((or (= Y "R") (= Y "r"))
    
43.      (LL)
    
44.      (setq Y (/ L1 L2))
    
45.     )
    
46.   )
    
47.   (setq A (rtos (* (getvar "CDATE") 1E8)))
    
48.   (command "_.BLOCK" A PT AA "")
    
49.   (command "_.INSERT" A PT X Y "")
    
50.   (command "_.EXPLODE" "L")
    
51.   (prompt "\n")
    
52.   (command "_.purge" "b" A "n")
    
53.   (setvar "osmode" holdosmode)
    
54.   (command "_.undo" "_end")
    
55.   (princ)
    
56. )
    

<br /> ;;;调整对象XY比例<br /> ;;;程序设计:赖云龙;;;<br /> ;;;---------------;;;<br /> (defun C:SCALEXY (/ holdosmode AA PT X Y PT1 PT2 L1 L2)<br />   (command "_.undo" "_be")<br />   (setq holdosmode (getvar "osmode"))<br />   (setvar "osmode" 39)<br />   (defun LL ()<br />     (setq PT1 (getpoint "\n参考长度基准点: "))<br />     (setq PT2 (getpoint PT1 "\n第二点: "))<br />     (setq L1 (distance PT1 PT2))<br />     (setq PT1 (getpoint "\n新的长度基准点: "))<br />     (setq PT2 (getpoint PT1 "\n第二点: "))<br />     (setq L2 (distance PT1 PT2))<br />   )<br />   (while (= AA NIL)<br />     (setq AA (ssget))<br />   )<br />   (setq PT (getpoint "\n基准点 : "))<br />   (setq X (getstring "\n<X比例系数>/参考(R) <1>: "))<br />   (cond<br />     ((= X "")<br />      (setq X 1)<br />     )<br />     ((or (= X "R") (= X "r"))<br />      (LL)<br />      (setq X (/ L1 L2))<br />     )<br />     (t<br />      (setq X (atof X))<br />     )<br />   )<br />   (setq        Y (getstring (strcat "\n<Y比例系数>/参考(R) <" (rtos X) ">: ")<br />           )<br />   )<br />   (cond<br />     ((= Y "")<br />      (setq Y 1)<br />     )<br />     ((or (= Y "R") (= Y "r"))<br />      (LL)<br />      (setq Y (/ L1 L2))<br />     )<br />   )<br />   (setq A (rtos (* (getvar "CDATE") 1E8)))<br />   (command "_.BLOCK" A PT AA "")<br />   (command "_.INSERT" A PT X Y "")<br />   (command "_.EXPLODE" "L")<br />   (prompt "\n")<br />   (command "_.purge" "b" A "n")<br />   (setvar "osmode" holdosmode)<br />   (command "_.undo" "_end")<br />   (princ)<br /> )<br />

cy956

最后不应该炸开，如有宽度的pline线炸后成单线了。

xlmx-whj

請问这个lap程序应当怎么加载它的起动命令是什么

hgqhq

直接把代码粘贴到cad命令行，输入SCALEXY命令即可运行

lwjjj

太复杂了，看不懂

zzyxhqplay

是一段好代码，如应用到其它程序中去，如地质钻孔绘制，将带来很大的便利

海豚

新旧参考长度好像反过来了。

bluesky1000

这个程序里还有些问题，我已经修改了一下。

cuiwenjun2008

我以前好像是把它粘贴到记事本中，再另存好像就是LISP了，这回怎么不行了呢？