LSP中怎么将宋体和黑体字移动到其他图层中。

发布网友发布时间：2022-05-10 21:24

共1个回答

热心网友时间：2023-11-02 04:22

高版本的AutoCAD里面有样条曲线转换为多段线功能。

要变圆弧的话就比较复杂，因为计算精度的问题基本上做不到，可以变为多段线。

autolisp代码如下：复制到记事本，以【.lsp】为后缀命名，打开CAD，输入命令【appload】加载到【启动组】。命令分别为【TES1,TES2】,可以自己修改。

;修改指定字体到指定图层
(defun c:tes1 ( / b1 b2 doc ent msp obj ss tc1 zt)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-mp-object) (vl-load-com) )
(if (and (setq ent (entsel "\n请选择要移动图层的参考字体"))
  (setq zt (cdr (assoc 7 (entget (car ent)))));取得字体样式
  (setq ent (entsel "\n请指定参考图层"))
  (setq tc1 (cdr (assoc 8 (entget (car ent)))));修改的指定图层
  )
  (progn
   (setq doc (vla-get-activedocument (vlax-get-acad-object));取得当前所有对象集合
         msp (vla-get-ModelSpace doc);取得空间模型
         ss '()
   )
   (vlax-for obj msp;图纸上的所有对象检查
    (if (and (= (vla-get-ObjectName obj) "AcDbText") (= (vla-get-StyleName obj) zt));如果字体符合要求
     (vla-put-layer obj tc1);就修改文字图层为指定图层
    )
   );
   (setq b1 (vla-get-blocks doc));取得所有块集合;检查块里面的文字
   (vlax-for b2 b1;检查每个块
    (vlax-for obj b2;检查块里面的对象
     (if (and (= (vla-get-ObjectName obj) "AcDbText") (= (vla-get-StyleName obj) zt));如果字体符合要求
      (vla-put-layer obj tc1);就修改文字图层为指定图层
     )
    );for;2
   );for;1
  )
)
(princ)
)

;;修改样条曲线为多段线
(defun c:tes2 ( / a70 a8 dis ent i n p1 ss1 x)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-mp-object) (vl-load-com) )
(if (and (setq ent (entsel "\n请选择样条曲线"))
     (setq ent (car ent))
     (= (cdr (assoc 0 (entget ent))) "SPLINE")
    )
  (progn;;1
   (initget 6)
   (if (setq n (getint "\n请输入要等分的数量"));if2
    (progn;;2
     (setq i -1.0 dis (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ss1 '());计算出曲线长度
     (while (< (setq i (1+ i)) n)
      (setq p1 (vlax-curve-getPointAtDist ent (/ (* i dis) n)));按平均值取点
      (setq ss1 (cons p1 ss1))
     );while
     (if (vlax-curve-isClosed ent);如果封闭，多段线也封闭
      (setq a70 '(70 . 1))
      (setq ss1 (cons (vlax-curve-getEndPoint ent) ss1) a70 '(70 . 0))
     );if
     (setq a8 (assoc 8 (entget ent)))
     (entdel ent);删除样条曲线
     (entmake (append
      (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDbPolyline") (cons 90 (length ss1)) a70 '(43 . 0) '(38 . 0))
      (mapcar '(lambda (x) (cons 10 x)) ss1)
     ));绘制多段线
    );progn;2
   );if;2
  );progn;1
);if;1
(princ)
)