[编程交流] LISP编程帮助-

 
(defun C:demo(/ date dx dy elist en file fname headers lay line name plott pt rot sset)
(defun dxf( key alist / )(cdr (assoc key alist)))
; Convert value in radians to degrees
(defun rtd (a) (* 180.0 (/ a pi)))
; Convert value in degrees to radians
(defun dtr (a) (* pi (/ a 180.0)))
(setvar "dimzin" 0)
(if (setq sset (ssget "_X" '((0 . "insert")(8 . "Plot-*"))))
 (progn
   (setq headers "Layer Name, Block Name, CoordX, CoordY, Rotation")
(setq plott (cons headers plott))
   (while (setq en (ssname sset 0))
     (setq elist (entget en))
     (setq lay (dxf 8 elist)
    name (dxf 2 elist)
    pt (dxf 10 elist)
    dx (car pt)
    dy (cadr pt)
    rot (rtd (dxf 50 elist)))
     (setq line (strcat lay ","name","(rtos dx 2 1)","(rtos dy 2 1)"," (rtos rot 2 0)))
     (setq plott (cons line plott))
     (ssdel en sset))
 (setq plott (reverse plott))
 (if plott
   (progn
 (setq date (menucmd "M=$(edtime,$(getvar,date),MO_DD_YY_HH_MM)"))
 (setq fname (strcat (getvar "dwgprefix") (strcat "PlanBlockCoords_" date ".csv")))
  (if (setq file (open fname "w"))
       (progn
           (foreach line plott
               (write-line line file)
           )
           (close file)
          )
       )
 )
   )
(alert (strcat "Saved in file: \n" fname))
 )
 )
 (princ)
 )
 (prompt "\n\t---\tType demo to write blocks to csv\t---")
(prin1)

(defun C:demo2 (/ bulge ec date dx dy en enh epar  file fname found headers
 hobjs hset info inspts line obj plott pt rest spar sset tail)
(vl-load-com)
 
(setvar "dimzin" 0)
(command "_zoom" "_e")
(if (setq sset (ssget  '((0 . "lwpolyline")(8 . "Plot-*"))))
 (progn
   (setq hset (ssget "_X" '((0 . "hatch")(8 . "Plot-*"))))
   (while (setq enh (ssname hset 0))
     (setq hobjs (cons (vlax-ename->vla-object enh) hobjs))
     (ssdel enh hset))
   (setq headers "Layer Name, Entity Name, CoordX, CoordY, Bulge, HatchEntityName, HatchStyle")
   (setq plott (cons headers plott))
   (while (setq en (ssname sset 0))
     
   (setq obj (vlax-ename->vla-object en))
     (setq found nil)
     (foreach hobj hobjs
     (if (not (vl-catch-all-error-p (setq inspts (vl-catch-all-apply'(lambda()(vla-intersectwith obj hobj acExtendNone))))))
(progn
(setq found T)
(setq tail (strcat "," (vla-get-handle hobj) "," (vla-get-patternname hobj))))
       (setq tail (strcat ",NULL,NULL"))))
  (setq line (strcat (vla-get-layer obj) ","(vla-get-handle obj)","))
  (setq spar (vlax-curve-getstartparam obj)
         epar (vlax-curve-getendparam obj))
     (if (eq :vlax-true (vla-get-closed obj))(setq ec epar)(setq ec (+ epar 1)))
(while (< spar ec)
     (setq pt (vlax-curve-getpointatparam obj spar))
     (setq dx (car pt)
    dy (cadr pt))
     (setq bulge (abs (vlax-invoke obj 'getbulge spar)))
     (setq rest (strcat (rtos dx 2 1)"," (rtos dy 2 1)"," (rtos bulge 2 2)))
     (setq info (strcat line rest tail))
     (setq plott (cons info plott))
     (setq spar (1+ spar)))
     (ssdel en sset))
  (setq plott (reverse plott)) 
(if plott
   (progn
 
 (setq date (menucmd "M=$(edtime,$(getvar,date),MO_DD_YY_HH_MM)"))
 
 (setq fname (strcat (getvar "dwgprefix") (strcat "PlanPolylineCoords_" date ".csv")))
 
  (if (setq file (open fname "w"))
       (progn
           
           (foreach line plott
     
               (write-line line file)
           )
           (close file)
          )
       )
 )   
)
   )
 )
(princ)
)
(prompt "\n")
(prompt "\n\t***\tType demo2 to execute...\t***\n")
(princ)