[编程交流] 东距和北距Lisp路由

 ;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;alan thompson (6.4.07)
(DEFUN C:PID()
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond     ((= answer "L")        (setq kopy 1))
       ((= answer "leader")    (setq kopy 1))
       ((= answer "")        (setq kopy 1))
       ((= answer "N")        (setq kopy 2))
       ((= answer "No")    (setq kopy 2))
       (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq pt2 (getpoint pt "\nSelect point for text placement: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
)
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
)
) ; End of Progn
) ; End of If
(princ))

 
(defun c:NEL
      (/ ANNOTATION LEADERPOINT NEWMLEADER POINT POINTS)
 (vl-load-com)
 (setq Point     (getpoint "\nSpecify point: ")
Point     (list (car Point) (cadr Point) 0.0)
LeaderPoint (getpoint Point "\nSpecify Leader End Point: ")
LeaderPoint (list (car LeaderPoint) (cadr LeaderPoint) 0.0)
Points     (vlax-make-safearray vlax-vbDouble '(0 . 5))
Points     (vlax-safearray-fill Points (append Point LeaderPoint))
Annotation
     (strcat "N "
      (rtos (cadr Point))
      "[url="file://PE/"]\\PE[/url] "
      (rtos (car Point))
     )
Annotation
     (vlax-invoke-method
       (findSpace)
       'AddMtext
       (vlax-safearray-fill
  (vlax-make-safearray vlax-vbDouble '(0 . 2))
  LeaderPoint
       )
       0
       Annotation
     )
 )
 (vlax-put-property
   Annotation
   'Height
   (* (getvar "dimscale") (getvar "dimtxt"))
 )
 (vlax-invoke-method
   (FindSpace)
   'AddLeader
   Points
   Annotation
   acLineWithArrow
 )
)

 
 (defun
       FINDSPACE
                (/ *DOC*)
   (vl-load-com)
   (setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
   (setq SPACE (if (= 1 (vla-get-activespace *DOC*))
                 (vla-get-modelspace *DOC*) ;we're in modelspace
                 (if (= (vla-get-mspace *DOC*) :vlax-true)
                   (vla-get-modelspace *DOC*) ;we're in modelspace
         ;thru paperspace VPort
                   (vla-get-paperspace *DOC*) ;we're in paperspace
                 ) ;_ end of if
               ) ;_ end of if
   ) ;_ end of setq
 ) ;_ end of defun

    
(defun C:Ref()
(Setq Ref_point nil)
   (while (= Ref_point nil)
       (Setq Ref_point (getpoint "\nSelect point of reference\n"))
      
           (cond
               ( (= Ref_point nil)
                   (alert "No point selected")
               )
          
           )
         )
    (setq precis 0)
    (setq Xval (car Ref_point) Yval (cadr Ref_point))
         (setq Xtxt (rtos Xval 2 precis))
          (setq Xco1(substr Xtxt 1 3))
        (setq Xco2(substr Xtxt 4 6))
           (Setq X_Final(strcat "X: "Xco1","Xco2))
       (setq Ytxt (rtos Yval 2 precis))
    
          (setq Yco1(substr Ytxt 1 3))
          (setq Yco2(substr Ytxt 4 6))
             (Setq Y_Final(strcat "Y: "Yco1","Yco2))
     ;Ordinance detail;
         (Setq Ord1 (substr Xco1 1 1))
         (Setq Ord2 (substr Yco1 1 1))
     (Setq Ordref (strcat Ord1 Ord2))
         (Setq Ordinance_convert (atoi Ordref))
(Setq Ordinance "_-_-_-_-_-_-_-WRMGB_-_-_XSNHC_-_-_YTOJD_-_-_ZU-K")
  
     (Setq Ordinance_letter (substr Ordinance Ordinance_convert 1))
    
       (Setq Ord_numX (Substr Xtxt 2 2))
       (Setq Ord_numY (Substr Ytxt 2 2))
(Setq Ordinance_final( strcat "(N" Ordinance_letter ": " Ord_numX Ord_numY ")")) 
   ;Printing Text;
  (command "text""s""Standard" Ref_point"" X_final)
         (Setq X_print (entlast))
 (command "text" ""Y_final)
         (Setq Y_print (entlast))
 (command "text" ""Ordinance_final)
         (Setq Ord_print (entlast))
)