• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Lisp to Excel VBA

cad1996

New Member
Dear Experts,

I have a Lisp code that needs to be converted into Excel VBA code.
Code:
(vl-load-com); load activex support

(defun C:CLabel (/ askString askReal initialize finish get_pline_vertices divide_selection get_crossing_points draw_text ; local functions
           savDimzin savTextStyle savLayer ss ssAll ssH ssV dimscl gspace autoS)

 (defun askString (msg def / ask)
  (initget "Yes No")

  (if (not (setq ask (getkword (strcat "\n" msg " <" def ">: "))) )
   (setq ask def)
   (setq def ask)
  )
 ); askstring
 
 (defun askReal (msg def / ask)
  (initget (+ 2 4))
  
  (if (not (setq ask (getreal (strcat "\n" msg " <" (rtos def 2) ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); askreal
 
 (defun initialize ()
  (setvar "cmdecho" 0)
  (command "._undo" "_begin")
  
  (setq savDimzin (getvar "dimzin"))
  (setvar "dimzin" 0)
 
  (setq savTextStyle (getvar "textstyle"))
  (if (not (tblsearch "style" "arial"))
   (command "._style" "arial" "arial" 0 1 0 "n" "n")
   (command "._textstyle" "arial")
  )
 
  (setq savLayer (getvar "clayer"))
  (foreach lay '("grid" "grid-text")
   (if (not (tblsearch "layer" lay))
    (command "._layer" "_make" lay "")
   )
  )

  (if (= (getvar "userr3") 0.0)
   (setvar "userr3" 250.0)
  )
  
  (setq dimscl (getvar "dimscale"))
 ); initialize

 (defun finish ()
  ; restore vars
  (setvar "clayer" savLayer)
  (command "._textstyle" savTextStyle)
  (setvar "dimzin" savDimzin)
  
  (command "._undo" "_end")
  (setvar "cmdecho" 1)
 ); finish

 (defun get_pline_vertices (ename / expand_pline ; local function
                         plineObj1 offset^ edata vertices^)

  ; expand pline outside more 10 units
  ; this would make sure all hatch lines would be auto selected
  
  (defun expand_pline (/ offset_pline ; local function
              plineObj0)

    (defun offset_pline (dist)
     (vlax-safearray->list
         (vlax-variant-value
           (vla-offset plineObj0 dist)
         )
     )
    ); setq

    (setq plineObj0 (vlax-ename->vla-object ename))
    (setq plineObj1 (car (setq offset^ (offset_pline 10))))

   (if (< (vlax-curve-getArea plineObj1)
      (vlax-curve-getArea plineObj0))
    (progn
     (foreach pl offset^
      (vla-delete pl)
      (vlax-release-object pl)
     )
    
     (setq plineObj1 (car (setq offset^ (offset_pline -10))))
    ); progn
   ); if

   (vlax-release-object plineObj0)
  ); expand_pline

  (expand_pline)
  (setq edata (entget (vlax-vla-object->ename plineObj1)))
  
  (setq vertices^
     (vl-remove-if
         'not
           (mapcar
           '(lambda (item)
              (if (= (car item) 10)
           (cdr item)
              )
            ); lambda
            edata
           ); mapcar
         ); vl-remove-if
  )

  (foreach pl offset^
   (vla-delete pl)
   (vlax-release-object pl)
  )

  vertices^
 ); get_pline_vertices
 
 (defun divide_selection (/ is_ortho ; local function
                ang)
  
  (defun is_ortho (ent / elist p10 p11)
   (setq elist (entget ent))
   (setq p10 (cdr (assoc '10 elist)))
   (setq p11 (cdr (assoc '11 elist)))

   (cond
    ((equal (cadr p10) (cadr p11) 1e-9)
     0.0
    )
    ((equal (car p10) (car p11) 1e-9)
     90.0
    )
    ( t
     nil
    )
   ); cond
  ); is_ortho
                
  (setq ssH (ssadd) ssV (ssadd))
  (foreach ename0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssAll)))
   (if (setq ang (is_ortho ename0))
    (if (= ang 0.0)
     (ssadd ename0 ssH)
     (ssadd ename0 ssV)
    ); if
   ); if
  ); foreach
 ); divide_selection
  
 (defun get_crossing_points (/ AcDbLine1 AcDbLine2 lst)
  (foreach ename1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssH)))
   (setq AcDbLine1 (vlax-ename->vla-object ename1))
   (foreach ename2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssV)))
    (setq AcDbLine2 (vlax-ename->vla-object ename2))
    (if (setq c0 (vlax-invoke AcDbline1 'intersectwith AcDbLine2 acExtendNone))
     (setq lst (cons c0 lst))
    )
    (vlax-release-object AcDbLine2)
   ); foreach
   (vlax-release-object AcDbLine1)   
  ); foreach

  lst
 ); get_crossing_points

 (defun draw_text (pt hgt ang text)
  (entmake
   (list
     '(0 . "TEXT")
     '(100 . "AcDbText")
     '(71 . 0)
     '(72 . 0)
     '(73 . 0)
     (cons '10 pt)
     (cons '40 hgt)
     (cons '50 ang)
     (cons '1  text)
   ); list
  ); entmake
 ); draw_text

 
 ; here start command
 (initialize)

 (if (and
       (setvar "users3" (setq autoS (askString "Auto select grid lines" "Yes")))
       (setvar "userr3" (setq gspace (askReal "Specify spacing between grid lines" (getvar "userr3"))))
       (setq ss (ssget "_:S:E+." '((0 . "lwpolyline"))))
     )
  (progn
   (setq savSnapbase (getvar "snapbase"))
   (command "._snapbase" '(0.0 0.0))
   (setvar "clayer" "grid")
   (command "._hatch" "_U" 0 gspace "_yes" "_si" "_None" (ssname ss 0))
   (command "._explode" "_last")
  
   (if (eq autoS "Yes")
    (setq ssAll (ssget "_wp" (get_pline_vertices (ssname ss 0)) '((0 . "line") (8 . "grid"))))
    (setq ssAll (ssget '((0 . "line") (8 . "grid"))))
   ); if
  
   (if (and ssAll (> (sslength ssAll) 0))
    (progn
     (divide_selection)
     (setvar "clayer" "grid-text")
     (foreach c0 (get_crossing_points)
      (draw_text (list (+ (car c0) (* 2.0 dimscl)) (+ (cadr c0) (* 0.5 dimscl)) 0.0) (* 2.5 dimscl) 0.0        (strcat "N" (rtos (cadr c0) 2 0)))
      (draw_text (list (+ (car c0) (* 0.5 dimscl)) (- (cadr c0) (* 2.0 dimscl)) 0.0) (* 2.5 dimscl) (* pi 1.5) (strcat "E" (rtos (car  c0) 2 0)))
     ); foreach 
    ); progn
   ); progn
  
   (command "._snapbase" savSnapbase)
  ); progn
 ); if

 (finish)

 (princ)
); C:Clabel
 
I've heard of LISP, but never used it. There may be someone here who knows LISP, but I'm guessing you're better off finding someone who knows VBA (me or someone else) and contacting them off-line—or rather, on-line but off this forum—to collaborate on a translation. You would explain what the LISP program does, and I could teach you how to write that in VBA, a piece at a time.

I say "I" could do it, but it doesn't have to be me, just anyone you prefer who can explain VBA code to you.
 
Back
Top