麻烦大佬帮我看看这段代码错在哪里，每次当数据集增大就会出错，请指教！！！

陈同学 · 发表于 2021-4-2 16:05

;此代码主要功能是将文字画下引线，并在引线下中心处输入文字
(defun c:xgl()
(vl-load-com)
(setq obj (vlax-get-acad-object));取得CAD母体对象
(setq dwgobj (vla-get-ActiveDocument obj));取当前的图形文件对象
(setq mspace (vla-get-ModelSpace dwgobj));取模型空间集合对像
(setq ss (ssget '((0 . "text"))))
(setq lst nil)
(setq i 0)
(setq dll (getstring "\n 输入文字"))
(repeat (sslength ss)
(setq pt1 nil)(setq pt2 nil)(setq p2 nil)(setq pt3 nil)
(setq lst (cons (ssname ss i) lst))
(setq i (1+ i))
(setq vlalst (mapcar 'vlax-ename->vla-object lst))
(setq boxlst (mapcar '(lambda (x / cor1 cor2)
(vla-GetBoundingBox x 'cor1 'cor2)
(list (vlax-safearray->list cor1)
(vlax-safearray->list cor2)
)
)
vlalst
)
)
(setq pt1 (list (car (car(car boxlst)))(-(cadr (car(car boxlst)))100)))
(setq pt2 (list (car (cadr(car boxlst)))(cadr (cadr(car boxlst)))))
(setq p2 (list (car (cadr(car boxlst))) (-(cadr (car(car boxlst)))100)))
;(command "RECTANG" pt1 pt2)
(wztc)
(entmake (list '(0 . "LINE")
(cons 10 pt1)
(cons 11 p2)
)
)
;确定输入文字位置
(setq pt3 (list (/ (+ (car pt1) (car p2)) 2)
(- (/ (+ (cadr pt1) (cadr p2)) 2) 300)
0
)
)
(command "text" "s" "REALCAD" "J" "M" pt3 "400" "0" dll );采用中心对齐方式
)
)

fs_lzh1988 · 发表于 2021-4-3 09:22

1、把(wztc)删了； 2、把 REALCAD替换为你的字体样式即可

xyp1964 · 发表于 2021-4-4 21:21

(defun c:tt ()
(if (setq ss (ssget '((0 . "text"))))
(progn
(setq tx (getstring "\n输入文字: ")
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(vla-GetBoundingBox (vlax-ename->vla-object s1) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
p2 (list (car p2) (cadr p1))
p1 (Polar p1 (* pi 1.5) 100)
p2 (Polar p2 (* pi 1.5) 100)
p3 (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
p3 (Polar p3 (* pi 1.5) 200)
)
(command "LINE" p1 p2 "")
(command "text" "J" "M" p3 "400" "0" tx)
)
)
)
(princ)
)

账号		自动登录	找回密码
密码			注册

[源码] 麻烦大佬帮我看看这段代码错在哪里，每次当数据集增大就会出错，请指教！！！