| 
 | 
(defun c:test() 
(setq desktop (strcat (lt:sys-deskTopDir) "\\坐标导出.txt")) 
(setq ff (open desktop "w"))  
  (setq b (getreal "\n请输入纵向比例尺.<200>:")) 
  (setq c (getreal "\n请输入横向比例尺.<200>:")) 
  (if (not b) (setq b 0.2) (setq b (/ b 1000))) 
  (if (not c) (setq c 0.2) (setq c (/ c 1000))) 
(while 
(SETQ ENT1 (ENTSEL "\n选择桩号 :")) 
      (IF (= ENT1 NIL)(PRINC "\n无效选择")  
          (PROGN 
          (SETQ ENT1 (ENTGET (CAR ENT1))) 
          (IF (/= (CDR (ASSOC 0 ENT1)) "TEXT")  
              (PRINC "\n选择对象非文本对象") 
              (PROGN  
                (setq ZZHH (cdr (assoc 1 ent1))) 
              ) 
           ) 
           ) 
      ) 
(princ "选择基准位置:") 
(setq point (getpoint) pty (cadr point)) 
(SETQ ENT (ENTSEL "\n选择基准位置参照高程对象 :")) 
      (IF (= ENT NIL)(PRINC "\n无效选择")  
          (PROGN 
          (SETQ ENT (ENTGET (CAR ENT))) 
          (IF (/= (CDR (ASSOC 0 ENT)) "TEXT")  
              (PRINC "\n选择对象非文本对象") 
              (PROGN  
                (setq GCZ (atof (cdr (assoc 1 ent)))) 
              ) 
           ) 
           ) 
      ) 
(princ "选择提取位置") 
(princ ZZHH ff) 
 (princ "\n" ff) 
(while 
(setq point2 (getpoint)) 
(setq y2 (cadr point2)) 
(setq pianju (- (car point2) (car point)))  
(setq x0 (car point) y0 (cadr point)) 
  (setq pianju (* pianju c)) 
  (setq d (* (- y2 pty) b) yz (rtos (+ GCZ d) 2 2)) 
 
  (princ yz ff) 
 (princ " " ff) 
  (princ pianju ff) 
 (princ "\n" ff) 
(princ) 
) 
) 
(close ff) 
) 
 
(defun lt:sys-deskTopDir () 
(vlax-invoke-method 
(vlax-get-property (vlax-create-object "wscript.shell") 'SpecialFolders) 
'Item 
"desktop" 
) 
)  
 
 |   
 
 
 
 |