[编程交流] Cilinder效应2d（误差2

; cilinder effect
(defun c:cef (/ p1 p2 obj ll ur ltp sc ent an OldOsmode DIR FILE VARLST VARLT X)
 (vl-arx-import 'BPOLY)  
 (or (findfile "cyl1.pat")
     (progn
(setq dir  (vl-filename-directory (findfile "acad.exe"))
      file (open (strcat dir "[url="file://cyl1.pat/"]\\cyl1.pat[/url]")
   "w"
    )
)
(mapcar (function(lambda (x)
    (princ x file)
    (princ "\n" file)
  ))
 (list
   "*cyl1,Cylinder effect"  "0, 0,0.01, 0,1"
   "0, 0,0.02, 0,1"    "0, 0,0.04, 0,1"
   "0, 0,0.08, 0,1"    "0, 0,0.16, 0,1"
   "0, 0,0.30, 0,1"    "0, 0,0.50, 0,1"
   "0, 0,0.70, 0,1"    "0, 0,0.84, 0,1"
   "0, 0,0.92, 0,1"    "0, 0,0.96, 0,1"
   "0, 0,0.98, 0,1"    "0, 0,0.99, 0,1"
  )
)
(close file)
     )
 )
 (foreach var
       '(("cmdecho" . 0)
  ("osmode" . nil)
  ("cecolor" . "253")
  ("snapbase" . nil)
  ("hporiginmode" . nil)
  ("hporigin" . nil)
 )
   (setq varlst (cons (cons (car var) (getvar (car var)))
        Varlst
  )
   )
   (if (cdr var)
     (setvar (car var) (cdr var))
   )
 )
 (or sc (setq sc 1.00))
 (or an (setq an (/ pi 2)))
 (setq OldOsmode (getvar "osmode"))
 (if (/= (logand oldosmode 16384) 16384)
   (setvar "osmode" (+ oldosmode 16384))
 )
 (setq ent (bpoly (getpoint "\n Specify internal point:"))
 )
 (if ent
   (progn
     (setvar "osmode" oldosmode)
     (setq
p1 (getpoint (strcat "\n Specify first point for distance: <"
       (rtos sc 2 2)
       ">"
      )
   )
     )
     (if p1
(setq p2 (getpoint p1 "\n Specify second point: ")
)
(progn
  (vla-getboundingbox
    (vlax-ename->vla-object ent)
    'll
    'ur
  )
  (setq
    ltp (mapcar 'vlax-safearray->list (list ll ur))
    p1 (car ltp)
    p2 (list (car (cadr ltp)) (cadr (car ltp)))
  )
)
     )
    ; (command "line" (trans p1 0 1) (trans
    ; p2 0
    ; 1))
     (setq sc (distance (trans p1 0 1) (trans p2 0 1))
    an (+ (angle p1 p2) (/ pi 2))
     )
     (if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)
(progn
  (setvar "hporiginmode" 0)
  (setvar "hporigin" (reverse (cdr (reverse p1))))
)
(setvar "snapbase" (reverse (cdr (reverse p1))))
     )
     (command "-bhatch"
       "p"
       "CYL1"
       sc
       (radian->degrees an)
       "s"
       ent
       ""
       ""
     )
     (entdel ent)
   )
 )
 (if varlst
   (mapcar '(lambda (x)
       (setvar (car x) (cdr x))
     )
    varlt
   )
 )
 (princ)
)
(DEFUN Radian->Degrees (nbrOfRadians /)
 (* 180.0 (/ nbrOfRadians PI))
) ;_ end of defun