[编程交流] 孔ID的Lisp

 
;; local defun  
(defun dxf (key elist)
 (cdr (assoc key elist))
 )
;;;;; main part  
(defun C:NL (/ *error *base bname color dia ds dxflist elist en layer
       note ort osm pt rad resp sset txtheight
       txtstyle vpt xs xv ys yv)
 ;; error trapping routine
 (defun *error* (msg)
 (if
   (and msg
   (vl-position
     msg
     '("console break"
"Function cancelled"
"quit / exit abort"
)
     )
 )
   (princ (strcat "\n** Error: " msg " **"))
   (princ "\nError!")
   )
 (command "undo" "end")  
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))
 (princ)
)
 (command "undo" "begin")
 (setq osm (getvar "osmode"))
 (setvar "osmode" 32)
 (setq ort (getvar "orthomode"))
 (setvar "orthomode" 0)
 (setq txtheight 35.0
txtstyle "ISOCP"
layer "DIMS"
color 2
)
(setq base (getpoint "\nPick base point (red cross): "))
(prompt "\n\t\t\t>>> Select circle or block (or press Enter to Exit) >> ")
(while (setq sset (ssget "+.:E:S" (list (cons -4 "<OR")
    (cons 0 "INSERT")
    (cons 0 "CIRCLE")
    (cons -4 "OR>"))))
 (setq en (ssname sset 0)
 elist (entget en)
)
 (if (eq "CIRCLE" (dxf 0 elist))
   (progn
 (setq pt  (dxf 10 elist)
       xv  (abs (- (car base) (car pt)))
       xs  (rtos xv 2 0)
       yv  (abs (- (cadr base) (cadr pt)))
       ys  (rtos yv 2 0)
       rad (dxf 40 elist)
       dia (* rad 2)
       ds  (rtos dia 2 1)
       )
     (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)
(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )
(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )
(entmod dxflist)
(entupd (entlast))
   )
   (progn
     (setq pt   (dxf 10 elist)
    xv   (abs (- (car base) (car pt)))
    xs   (rtos xv 2 0)
    yv   (abs (- (cadr base) (cadr pt)))
    ys   (rtos yv 2 0))
     (setq obj (vlax-ename->vla-object en))
     (vla-getboundingbox obj 'minp 'maxp)
     (setq bp (vlax-safearray->list minp)
    up (vlax-safearray->list maxp)
    dia (abs (- (car up)(car bp)))
    ds   (rtos dia 2 1)
    )
           (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)
(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )
(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
 )
(entmod dxflist)
(entupd (entlast))
  )
)
)
(initget "Yes No")
 (setq resp (getkword "\nDo you want to draw notes? [Yes/No] <Y>: "))
 (if (not resp)(setq resp "Yes"))
 (if (eq "Yes" resp)
   (progn
     (setvar "osmode" 33)
   (while (setq pt (getpoint "\nPick point (or press Enter to Exit): "))
     (setq note (getstring T "\nEnter note text: "))
     (setq xv (abs (- (car base) (car pt)))
    xs (rtos xv 2 0)
    yv (abs (- (cadr base) (cadr pt)))
    ys (rtos yv 2 0)
    )
(command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" note) pause)
(setq dxflist (entget (entlast))
     vpt (dxf 14 dxflist)
     )
(if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
      (setq dxflist (subst (cons 1 (strcat note " \t" xs "\t" ys))(assoc 1 dxflist) dxflist))
       (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" note))(assoc 1 dxflist) dxflist))
 )
(entmod dxflist)
(entupd (entlast))
   )
     )
   )
(*error* nil) 
(princ)
 )
(vl-load-com)
(prompt "\n   >>>   Type NL to run...")
(prin1)