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

 (defun layer_set (lyr col ltp)
 (setvar "cmdecho" 0)  
 (if (tblsearch "layer" lyr)
 (command "._-layer" "t" lyr "u" lyr "on" lyr  "s" lyr "")
 (command "._-layer" "m" lyr "c" col lyr "lt" ltp lyr ""))
 )
(or (vl-load-com))
(defun C:lne (/        *debug*        *error*        acsp        adoc        ang        anno        atp
        col        lead        lyr        mtextobj        mtpt        nodpt
        ort        osm        pt        ptlist        ss        tmparray
        tmpvar        txh        xval        yval
       )
 (defun *Error* (msg)
 (cond        ((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\nError: " msg))
 (cond (*Debug* (vl-bt)))
)
 )
 (setvar "cmdecho" 1)
 (setvar "delobj" 1)
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))
 (if lyr (setvar "clayer" lyr))
 (if col (setvar "cecolor" col))
   
 (vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
     )
)
 
 (or adoc
     (setq adoc (vla-get-activedocument
           (vlax-get-acad-object)
         )
     )
 )
 (or acsp
     (setq acsp (if (= (getvar "TILEMODE") 0)
           (vla-get-paperspace
             adoc
           )
           (vla-get-modelspace
             adoc
           )
         )
     )
 )
 (vla-endundomark adoc)
 (vla-startundomark adoc)
 
 (setq osm (getvar "osmode"))
 (setq lyr (getvar "clayer"))    
 (setq ort (getvar "orthomode"))    
 (setq col (getvar "cecolor"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (initget 6)
 (setq txh (getreal (strcat "\n  Enter New Value For Text Height <" (rtos (getvar "dimtxt")) "> :")))
 (if (not txh)(setq txh (getvar "dimtxt")))    
 (setvar "textsize" txh)
 (if (not (tblsearch "block" "ArrowDonut"))
     (progn
      (setq ss (ssadd))
      (setvar "delobj" 1)
      (layer_set "ANNO-LEADER" "10" "Continuous")  
      (setvar "cecolor" "256")
      (command "._circle" "0,0,0" 1.0);<-change outer diameter of donut here
      (ssadd (entlast) ss)
      (command "._circle" "0,0,0" 0.75);<-change inner diameter of donut here
      (ssadd (entlast) ss)
      (command "._-block" "ArrowDonut" "0,0,0" ss "")
 )
   )
      
 (while
 (setq pt (getpoint "\nSpecify the starting point of the leader (press Enter to exit): \n"))
 (setq ptlist (cons pt ptlist))
 (while (setq
   pt (getpoint "\nSpecify next point press Enter to finish: " pt)
 )
   (setq ptlist (cons pt ptlist)
   )
 )
 
 (setq ptlist (reverse ptlist))
 (setq ang (angle (car ptlist )(cadr ptlist)))
 (if (< (/ pi 2) ang (* pi 1.5))
   (setq atp acAttachmentPointMiddleRight)
   (setq atp acAttachmentPointMiddleLeft))
 (setq nodpt (car ptlist)
xval (rtos (car nodpt) 2 3); easting
yval (rtos (cadr nodpt) 2 3);northing
anno (strcat "N " yval "\\PE " xval)
mtpt (vlax-3d-point (cadr ptlist)))
 (layer_set "ANNO-TEXT" "2" "Continuous")
 (setvar "cecolor" "256")
 (setq        mtextobj (vla-addmtext
           acsp
           mtpt
           0.0
           anno
         )
 )
(vla-put-height mtextobj txh)
(vla-put-attachmentPoint mtextobj atp)
(vla-put-insertionPoint mtextobj mtpt)
 (setq ptlist (apply 'append ptlist))
 (setq        tmparray
 (vlax-make-safearray
   vlax-vbdouble
   (cons 0 (- (length ptlist) 1))
 )
 )
 (vlax-safearray-fill tmparray ptlist)
 (setq tmpvar (vlax-make-variant tmparray))
 (layer_set "ANNO-LEADER" "10" "Continuous")  
 (setvar "cecolor" "256") 
 (setq lead (vla-addleader acsp tmpvar mtextobj acLineWithArrow))
 (vla-put-verticaltextposition lead acvertcentered)
 (vla-put-arrowheadblock lead "arrowdonut")
 (vla-put-arrowheadsize lead (* 0.5 txh)) 
 (vla-update lead)
 (setq ptlist nil);optional
   )
 (vla-regen adoc acactiveviewport);optional
 (*Error* nil)
 (princ)
)
(princ "\n\t\t\t   |-----------------------------|\n")
(princ "\n\t\t\t  <|  Start with LNE to execute  |>\n")
(princ "\n\t\t\t   |-----------------------------|\n")