求一个按尺寸标注的基点批量插入块的程序

bai2000

贴一个论坛的朋友的按块基点进行标注的lisp，
求一个按尺寸标注的基点批量插入块的程序（块的方向能按尺寸方向角旋转）

xyp1964

xinhaichun

这个需求是可以做出来的，前提条件是标注的基点方向要足够精确

bai2000

院长，发个源码呗？？

1211277255

TT Error: no function definition: XYP-START 这个是什么问题

xyp1964

bai2000 发表于 2023-12-14 16:47
院长，发个源码呗？？

1. (defun c:tt()
   
2.   "tt(尺寸标注基点批量插块)"
   
3.   (defun xyp-R2D(r)(* r(/ 180 pi)))
   
4.   (defun xyp-dxf(code e)(cdr(assoc code(entget e))))
   
5.   (defun xyp-Ss2List(ss)(vl-remove-if-not'(lambda(x)(equal(type x)'ENAME))(mapcar'cadr(ssnamex ss))))
   
6.   (defun xyp-DelSame(lst / a l)(whilelst(setq a(car lst)lst(vl-remove a lst))(or(member a l)(setq l(append l(list a)))))l)
   
7.   (defun abc(ss bn / a lst x)
   
8.     (setq lst(mapcar'(lambda(x)(setq a(xyp-r2d(xyp-DXF 50 x)))(list(list(xyp-DXF 13 x)a)(list(xyp-DXF 14 x)a)))(xyp-Ss2List ss)))
   
9.     (mapcar'(lambda(x)(command"-insert"bn(car x)1 1(cadr x)))(xyp-DelSame(apply'append lst)))
   
10.   )
    
11.   (if(setq ss(ssget'((0 . "dim*"))))(abc ss "xlp3")) ;xlp3 图块名称
    
12.   (princ)
    
13. )
    

(defun c:tt()<br />   "tt(尺寸标注基点批量插块)"<br />   (defun xyp-R2D(r)(* r(/ 180 pi)))<br />   (defun xyp-dxf(code e)(cdr(assoc code(entget e))))<br />   (defun xyp-Ss2List(ss)(vl-remove-if-not'(lambda(x)(equal(type x)'ENAME))(mapcar'cadr(ssnamex ss))))<br />   (defun xyp-DelSame(lst / a l)(whilelst(setq a(car lst)lst(vl-remove a lst))(or(member a l)(setq l(append l(list a)))))l)<br />   (defun abc(ss bn / a lst x)<br />     (setq lst(mapcar'(lambda(x)(setq a(xyp-r2d(xyp-DXF 50 x)))(list(list(xyp-DXF 13 x)a)(list(xyp-DXF 14 x)a)))(xyp-Ss2List ss)))<br />     (mapcar'(lambda(x)(command"-insert"bn(car x)1 1(cadr x)))(xyp-DelSame(apply'append lst)))<br />   )<br />   (if(setq ss(ssget'((0 . "dim*"))))(abc ss "xlp3")) ;xlp3 图块名称<br />   (princ)<br /> )<br />