请各位大大虾帮个忙，将这个LISP程序改写成VBA，不胜感激

poly168 · 发表于 2005-6-20 09:47:00

请各位大大虾帮个忙，将这个LISP程序改写成VBA，不胜感激。我的LISP水平太差了。
defun dstbm    ()
   (setq mm (entlast))
   (setq pb (entget mm))
   (regapp "SOUTH")
   (setq
   xb
   (append
   pb
   (list
   (list '-3
   (list "SOUTH" (cons 1000 stbmx))
   )
   )
   )
   )
   (entmod xb)
   (princ)
   )
;;;批量展测量点
(defun c:zdtxt (/ l wzcl wzch l3 oldcmd oldblip oldsnap tckz newlayer fle fn pt dm zb xyz h lscale xyz1 xyz2)
   (setq l (getvar "ltscale"))
   (setq wzcl (* l 2))
   (setq wzch (* l 2))
   (setq l3 (angle (getvar "ucsorg")
   (getvar "ucsxdir")
   )
)
   (setq oldcmd (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (setq oldblip (getvar "blipmode"))
   (setvar "blipmode" 0)
   (setq oldsnap (getvar "osmode"))
   (setvar "osmode" 0)
   (setvar "angdir" 1)
   (setq fle (getfiled "请选择数据文件"
   "*"
   "txt;dat;*"
   2
   )
)
   (if (= (tblobjname "layer" "GCD") nil)
   (progn
   (command "layer" "n" "zd" "C" "1" "GCD" "")
   )
   )
   (setq fn (open fle "r"))
   (read-line fn)
   (setq n 0)
   (while (setq pt (read-line fn))
   (setq dm (vl-princ-to-string (read pt)))
   (setq zb (substr pt (+ (strlen dm) 1)))
   (setq
   xyz (trans (read (strcat "(" zb ")"))
   1
   0
   )
   )
   (setq h (rtos (last xyz) 2 1))
   (setq lscale (* l 1))
   (entmake
   (list (cons 0 "INSERT")
   (cons 100 "AcDbEntity")
   (cons 8 "GCD")
   (cons 100 "AcDbBlockReference")
   (cons 10 xyz)
   (cons 41 lscale)
   (cons 42 lscale)
   (cons 43 lscale)
   (cons 410 "model")
   (cons 2 "gc200")
   )
   ) ;"gc200"为块名
   (setq stbmx (itoa 202101))
   (dstbm)
   (setq xyz1
   (polar xyz (/ pi 2) (* l 2))
   )
   (setq xyz2
   (polar xyz (* (/ pi 2) 3) (* l 2))
   )
   (entmake (list (cons 0 "Text")
   (cons 100 "AcDbEntity")
   (cons 8 "GCD")
   (cons 100 "AcDbText")
   (cons 7 "standard")
   (cons 1 dm)
   (cons 40 wzcl)
   (cons 41 0.8)
   (cons 410 "model")
   (cons 71 0)
   (cons 72 4)
   (cons 73 0)
   (cons 10 xyz1)
   (cons 11 xyz1)
   )
   )
   (setq stbmx (itoa 202111))
   (dstbm)
   (entmake (list (cons 0 "Text")
   (cons 100 "AcDbEntity")
   (cons 8 "GCD")
   (cons 100 "AcDbText")
   (cons 7 "hz")
   (cons 1 h)
   (cons 40 wzch)
   (cons 41 0.8)
   (cons 410 "model")
   (cons 71 0)
   (cons 72 4)
   (cons 73 0)
   (cons 10 xyz2)
   (cons 11 xyz2)
   )
   )
   (setq stbmx (itoa 202111))
   (dstbm)
   (setq n (+ n 1))
   )
   (if (= pt nil)
   (progn
   (alert (strcat "*--*展点结束，共展"
   (itoa n)
   "个点*--*!。"
   )
   )
   (setvar "cmdecho" oldcmd)
   (setvar "blipmode" oldblip)
   (setvar "osmode" oldsnap)
   (setvar "angdir" 1)
   (setvar "clayer" "0")
   )
   )
   (close fn)
   (command "zoom" "E")
   (princ)
   )

请各位大大虾帮个忙，将这个LISP程序改写成VBA，不胜感激

发表回复

精选推荐