[LISP程序]：lsp程序-好用

crtrccrt

2. ;;;;======================================================================
   
3. ;;;;项目名：电气软件
   
4. ;;;;程序名：定义派生符号文字位置
   
5. ;;;;文件名：T-Dyfhk.Lsp
   
6. ;;;;函数名：c:Dyfhk
   
7. ;;;;功  能：定义派生符号文字位置
   
8. ;;;;输  入：无
   
9. ;;;;输  出：无用
   
10. ;;;;作  者：方祥军
    
11. ;;;;时  间：1998.10.27
    
12. ;;;;======================================================================
    
13. (defun c:Dyfhk( / str_n ent en e10 e40 e50 e41 e42 e2 pbz pbz1
    
14.                  xryr xr yr blh blx bly zh str hh x y aa a b c d1 d lna
    
15.                  ang errold i loop)
    
16. (setq errold *error* )
    
17. 
    
18. ;;{Dyfhk子函数开始---------------------------------------------
    
19. ;;-------------------------------------------------------
    
20. ;;函数名：*error*
    
21. ;;功  能：error函数
    
22. ;;-------------------------------------------------------
    
23. (defun *error*(msg /  )
    
24.   (foreach each '(str_n ent en e10 e40 e50 e41 e42 e2 pbz pbz1
    
25.                  xryr xr yr blh blx bly zh str hh x y aa a b c d1 d lna
    
26.                  ang errold i loop)
    
27.    (set each nil)
    
28.   )
    
29.   (setq *error* errold errold nil)
    
30.   (redraw)  
    
31.   (_resdwg)
    
32.   (princ)
    
33. )
    
34. ;;}Dyfhk子函数结束---------------------------------------------
    
35. 
    
36. ;;{dyfhk主函数开始---------------------------------------------
    
37. (if (= (ISFUNRUN) nil)(exit))
    
38. (princ "\n*派生符号位置定义*=Dyfhk")
    
39. (_inidwg)  
    
40. (setvar"cmdecho"0)
    
41. (setvar"osmode"0)
    
42.   (setq lna '() i 0)
    
43. (setq aa (xgetin "IdqMain" "IdqSys" "C:\\Idq30" 1))
    
44. (setq aa (strcat aa "\\Datcom\\Fhklib.Idp"))
    
45. (setq loop 1)
    
46. (while loop
    
47.    (setq ent (xentsl "\n请选择需定义标注位置的设备<回车结束>:" (list (cons 0 "insert"))))
    
48. 
    
49.    (if (= (type ent) 'LIST)
    
50.      (progn
    
51.            (setq ent (car ent))
    
52.      (setq en (entget ent))
    
53.      (setq e10(cdr (assoc 10 en)) e41(cdr (assoc 41 en)) e42(cdr (assoc 42 en))
    
54.       e50(cdr (assoc 50 en)) e2(cdr (assoc 2 en)))
    
55.        (if (> (_Sestr "--C" e2) 0)(setq e2 (car (_getnB e2 "--C"))))
    
56.         ;Luxiang add,When Select block as "0114_1",change block name as "0114".
    
57.         (setq str_n (substr e2 (- (strlen e2) 1) (strlen e2)))
    
58.       (if (or (= str_n "_1") (= str_n "_2") (= str_n "_3") (= str_n "_4"))
    
59.               (setq e2 (substr e2 1 (- (strlen e2) 2)))
    
60.           )
    
61.         (if (= (member e2 lna) nil)
    
62.         (progn
    
63.          (setq lna (cons e2 lna))
    
64.      (setvar "blipmode" 1)
    
65.      (setq pbz (getpoint e10 "\n请确定标注点(或直接输入距插入点的相对坐标)<回车结束>:"))
    
66.      (if pbz
    
67.          (progn
    
68.      (setq ang(angle e10 pbz))
    
69.      (setq ang (- ang e50))
    
70.      (setq pbz1 (distance2p e10 pbz))
    
71.      (setq xr (/ (* pbz1 (cos ang)) e41 ) yr(/ (* pbz1 (sin ang)) e42))
    
72.      ;(setq pbz1 (polar e10 (- 0.0 e50) (distance2p e10 pbz)))
    
73.     ; (setq xryr (list  (/ (- (car pbz) (car e10)) e41)
    
74.     ;                   (/ (- (cadr pbz) (cadr e10)) e42)
    
75.     ; )          )
    
76.     ; (setq xr (car xryr) yr(cadr xryr))
    
77.      (setq blh(strcat e2 "\\Hei"))
    
78.      (setq blx(strcat e2 "\\X"))
    
79.      (setq bly(strcat e2 "\\Y"))
    
80.      (setq zh(xgetps "Tkdata\\Dyfhk\\Wzgd" "2.5"))
    
81.      (if zh
    
82.         (setq str (strcat "\n请输入派生符号的文字高度<" zh ">:"))
    
83.         (progn (setq zh "2.5")
    
84.           (setq str "\n请输入派生符号的文字高度<2.5>:")
    
85.         )
    
86.     )
    
87.      (initget (+ 2 4))
    
88.      (setq hh(getreal  str))
    
89.      (if (not hh)
    
90.          (setq hh zh)
    
91.          (setq hh(rtos hh 2))
    
92.      )
    
93.      (setq x(rtos xr 2))
    
94.      (setq y(rtos yr 2))
    
95.      (setq a(xsetps blh hh aa))
    
96.      (setq b(xsetps blx x aa))
    
97.      (setq c(xsetps bly y aa))
    
98.      (setq d(xsetps "Tkdata\\Dyfhk\\Wzgd" hh))   
    
99.         )
    
100.         (setq loop nil)
     
101.         );;;;;lx;
     
102.         )
     
103.         )
     
104.         (setq i (+ i 1))
     
105.   )
     
106.   (setq loop nil)
     
107.   )        ;if (type ...) ends
     
108. );;;while ends
     
109. (setq *error* errold errold nil)
     
110. (_resdwg)
     
111. (princ)
     
112. )
     
113. ;;}Dyfhk主函数结束---------------------------------------------
     
114. 
     
115. (Setfunhelp "C:Dyfhk" "Idq30.hlp" "ID_TPsfhF")

;;;;======================================================================<br /> ;;;;项目名：电气软件<br /> ;;;;程序名：定义派生符号文字位置<br /> ;;;;文件名：T-Dyfhk.Lsp <br /> ;;;;函数名：c:Dyfhk<br /> ;;;;功  能：定义派生符号文字位置 <br /> ;;;;输  入：无<br /> ;;;;输  出：无用<br /> ;;;;作  者：方祥军<br /> ;;;;时  间：1998.10.27<br /> ;;;;======================================================================<br /> (defun c:Dyfhk( / str_n ent en e10 e40 e50 e41 e42 e2 pbz pbz1 <br />                  xryr xr yr blh blx bly zh str hh x y aa a b c d1 d lna<br />                  ang errold i loop)<br /> (setq errold *error* ) <br /> <br /> ;;{Dyfhk子函数开始--------------------------------------------- <br /> ;;-------------------------------------------------------<br /> ;;函数名：*error*<br /> ;;功  能：error函数<br /> ;;-------------------------------------------------------<br /> (defun *error*(msg /  )<br />   (foreach each '(str_n ent en e10 e40 e50 e41 e42 e2 pbz pbz1 <br />                  xryr xr yr blh blx bly zh str hh x y aa a b c d1 d lna<br />                  ang errold i loop) <br />    (set each nil)<br />   )<br />   (setq *error* errold errold nil)<br />   (redraw)  <br />   (_resdwg)<br />   (princ)<br /> ) <br /> ;;}Dyfhk子函数结束---------------------------------------------<br /> <br /> ;;{dyfhk主函数开始---------------------------------------------<br /> (if (= (ISFUNRUN) nil)(exit))<br /> (princ "\n*派生符号位置定义*=Dyfhk")<br /> (_inidwg)  <br /> (setvar"cmdecho"0) <br /> (setvar"osmode"0)<br />   (setq lna '() i 0)<br /> (setq aa (xgetin "IdqMain" "IdqSys" "C:\\Idq30" 1))<br /> (setq aa (strcat aa "\\Datcom\\Fhklib.Idp"))<br /> (setq loop 1)<br /> (while loop<br />    (setq ent (xentsl "\n请选择需定义标注位置的设备<回车结束>:" (list (cons 0 "insert"))))<br /> <br />    (if (= (type ent) 'LIST)<br />      (progn<br />            (setq ent (car ent))<br />      (setq en (entget ent))<br />      (setq e10(cdr (assoc 10 en)) e41(cdr (assoc 41 en)) e42(cdr (assoc 42 en))<br />       e50(cdr (assoc 50 en)) e2(cdr (assoc 2 en)))<br />        (if (> (_Sestr "--C" e2) 0)(setq e2 (car (_getnB e2 "--C"))))<br />         ;Luxiang add,When Select block as "0114_1",change block name as "0114".<br />         (setq str_n (substr e2 (- (strlen e2) 1) (strlen e2)))<br />       (if (or (= str_n "_1") (= str_n "_2") (= str_n "_3") (= str_n "_4"))<br />               (setq e2 (substr e2 1 (- (strlen e2) 2)))<br />           )<br />         (if (= (member e2 lna) nil)<br />         (progn<br />          (setq lna (cons e2 lna))<br />      (setvar "blipmode" 1)<br />      (setq pbz (getpoint e10 "\n请确定标注点(或直接输入距插入点的相对坐标)<回车结束>:"))<br />      (if pbz<br />          (progn<br />      (setq ang(angle e10 pbz))<br />      (setq ang (- ang e50))<br />      (setq pbz1 (distance2p e10 pbz))<br />      (setq xr (/ (* pbz1 (cos ang)) e41 ) yr(/ (* pbz1 (sin ang)) e42)) <br />      ;(setq pbz1 (polar e10 (- 0.0 e50) (distance2p e10 pbz)))<br />     ; (setq xryr (list  (/ (- (car pbz) (car e10)) e41)<br />     ;                   (/ (- (cadr pbz) (cadr e10)) e42)<br />     ; )          )<br />     ; (setq xr (car xryr) yr(cadr xryr))<br />      (setq blh(strcat e2 "\\Hei"))<br />      (setq blx(strcat e2 "\\X"))<br />      (setq bly(strcat e2 "\\Y")) <br />      (setq zh(xgetps "Tkdata\\Dyfhk\\Wzgd" "2.5"))<br />      (if zh<br />         (setq str (strcat "\n请输入派生符号的文字高度<" zh ">:")) <br />         (progn (setq zh "2.5")<br />           (setq str "\n请输入派生符号的文字高度<2.5>:")<br />         )<br />     )<br />      (initget (+ 2 4))<br />      (setq hh(getreal  str))<br />      (if (not hh)<br />          (setq hh zh)<br />          (setq hh(rtos hh 2))<br />      )<br />      (setq x(rtos xr 2))<br />      (setq y(rtos yr 2))<br />      (setq a(xsetps blh hh aa))<br />      (setq b(xsetps blx x aa))<br />      (setq c(xsetps bly y aa)) <br />      (setq d(xsetps "Tkdata\\Dyfhk\\Wzgd" hh))   <br />         )<br />         (setq loop nil)<br />         );;;;;lx;<br />         )<br />         )<br />         (setq i (+ i 1))<br />   )<br />   (setq loop nil)<br />   )        ;if (type ...) ends<br /> );;;while ends<br /> (setq *error* errold errold nil)<br /> (_resdwg)<br /> (princ)<br /> )<br /> ;;}Dyfhk主函数结束---------------------------------------------<br /> <br /> (Setfunhelp "C:Dyfhk" "Idq30.hlp" "ID_TPsfhF")

xyp1964

函数_resdwg未定义！

blackcary

就是不知道怎么用!

shen8016

太复杂了

qjcpj

最后贴个图并给予说明。

shq197528

电气的我不会了!不过还是版主有心!