直线或者两点多段线延伸

范建威

(defun c:ys()
(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq ENT (car (entsel"\n选择直线或者多段线: ")))
(setq ysjl (getdist"\n输入延伸距离: "))
(setq name (Vlax-Get (Vlax-Ename->Vla-Object ENT) 'ObjectName ));;获取对象的 AutoCAD 类名
(cond
  ((= name "AcDbLine");;直线
   (progn
    (setq pt1 (Vlax-Get (Vlax-Ename->Vla-Object ENT) 'StartPoint ));;;获取直线起点
    (setq pt2 (Vlax-Get (Vlax-Ename->Vla-Object ENT) 'EndPoint ));;;获取直线终点
    (setq leng (Vlax-Get (Vlax-Ename->Vla-Object ENT) 'Length ));;;获取直线距离
    (setq jl (+ ysjl leng));;;算出延伸后总距离
    (setq pt_1 (vlax-3D-point (polar pt2 (angle pt2 pt1) jl)));;;算出延伸后起点
    (setq pt_2 (vlax-3D-point(polar pt1 (angle pt1 pt2) jl)));;;算出延伸后终点
    (vla-Delete (Vlax-Ename->Vla-Object ENT ));;删除原直线
    (vla-addline mspace pt_1 pt_2);;;新建一条直线
   )
  )
  ((= name "AcDbPolyline");;多段线
   (progn
    (setq pt_list(Vlax-Get (Vlax-Ename->Vla-Object ENT) 'Coordinates ));;;获取多段线坐标表
    (setq pt1 (list (nth 0 pt_list) (nth 1 pt_list) ));;;算出第一个顶点坐标
    (setq pt2 (list (nth 2 pt_list) (nth 3 pt_list) ));;;算出第二个顶点坐标
    (vla-Delete (Vlax-Ename->Vla-Object ENT ));;删除原多段线;;;新建一条
    (vla-Addline mspace (vlax-3D-point pt1) (vlax-3D-point pt2));;;新建一条直线
   )
  )
)
)

csharp

1 length 命令即可
2 自己写的话修改起点和终点比删除并新生成更好

zhuzhi1631

不错很好,支持 顶你！

xdcad9819

直线或者两点多段线延伸 不错 支持