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