CAD直线修剪的二次开发将一直线通过一命令直接把中间剪断删除,保留相同距离的两端,两端的长度可设置,哪位大虾帮帮我搞个说SLP

CAD直线修剪的二次开发将一直线通过一命令直接把中间剪断删除,保留相同距离的两端,两端的长度可设置,哪位大虾帮帮我搞个说SLP
CAD直线修剪的二次开发
将一直线通过一命令直接把中间剪断删除,保留相同距离的两端,两端的长度可设置,
哪位大虾帮帮我搞个说SLP

CAD直线修剪的二次开发将一直线通过一命令直接把中间剪断删除,保留相同距离的两端,两端的长度可设置,哪位大虾帮帮我搞个说SLP
;;;;;;;;;;;;;;;分析对象子程序;;;;
(defun tt61 (ent / ob st en L1)
 (Setq ob (Vlax-Ename->Vla-Object ent) ;;转换为VLA对象
       st (Vlax-curve-getStartPoint ob) ;;取得曲线开始点
       en (Vlax-curve-getEndPoint ob);;取得曲线结束点
       L1 (Vlax-curve-getDistAtpoint ob en);;取得曲线长度
 )
 (if (>= L1 (* $$$k2 2))
  (progn
   (setq ps (vlax-curve-getPointAtDist ob $$$k2);;取得曲线上一点
         pn (vlax-curve-getPointAtDist ob (- L1 $$$k2))
   )
  )
 )
 (if (< L1 (* $$$k2 2)) (setq ps nil pn nil) )
 (list st ps en pn)
)
;;;;;;;;;;;;;;;;;;;输入长度子程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tt62 ( / #k1)
 (setq #k1 50 $$$k2 (getdist (strcat "\n请输入长度:<" (rtos #k1 2 2) ">")));;输入你想要的尺寸
 (if (= $$$k2 nil) (setq $$$k2 #k1) );;如果不输入,默认尺寸为50
)
;;批量选择直线子程序;;;
(defun tt63 ( / ent #os1 #os2 i ent1 ent2 %k1 @p1 @p2 @p3 @p4)
 (princ "\n请选择直线")
 (setq ent (ssget '((0 . "LINE"))))
 (setq #os1 (getvar "osmode") #os2 (getvar "clayer"))
 (setvar "osmode" 0)
 (if (/= ent nil)
  (progn
   (setq i 0)
   (repeat (sslength ent)
    (setq ent1 (ssname ent i)
          i (+ i 1)
          %k1 (cdr (assoc 8 (entget ent1)))
          ent2 (tt61 ent1)
          @p1 (nth 0 ent2)
          @p2 (nth 1 ent2)
          @p3 (nth 2 ent2)
          @p4 (nth 3 ent2)
    )
    (if (/= @p2 nil)
     (progn
      (setvar "clayer" %k1)
      (command "LINE" @p1 @p2 "")
      (command "LINE" @p3 @p4 "")
      (entdel ent1)
     )
    )
   )
  )
 )
 (setvar "osmode" #os1)
 (setvar "clayer" #os2)
) 
;;;;选择子程序;;;;;;
(defun tt64 ( / ent ent1 %k1 @p1 @p2 @p3 @p4 #os1 #os2)
 (setq ent nil)
 (initget "C X")
 (setq ent (entsel "\n请选择直线或[输入长度(C)/批量选择直线(X)]:<选择直线>"));;注意这个里面的选择方式
 (if (= ent "c") (setq ent "C") )
 (if (= ent "x") (setq ent "X") )
 (if (= ent "C")
  (progn
   (tt65)
   (tt64)
  )
 )
 (if (= ent "X") (tt63))
 (if (and (/= ent nil) (/= ent "C") (/= ent "X"))
  (progn
   (setq ent1 (car ent) %k1 (cdr (assoc 8 (entget ent1))) ent (tt61 ent1))
   (setq @p1 (car ent) @p2 (nth 1 ent) @p3 (nth 2 ent) @p4 (nth 3 ent))
   (setq #os1 (getvar "osmode") #os2 (getvar "clayer"))
   (if (/= @p2 nil)
    (progn
     (setvar "osmode" 0)
     (setvar "clayer" %k1)
     (command "LINE" @p1 @p2 "")
     (command "LINE" @p3 @p4 "")
     (entdel ent1)
     (setvar "osmode" #os1)
     (setvar "clayer" #os2)
    )
   )
  )
 )
)
;;;;;;;;;;;;;;;;;;;输入长度子程序;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tt65 ( / #k)
 (setq #k $$$k2 $$$k2 (getdist (strcat "\n请输入长度:<" (rtos $$$k2 2 2) ">")));;输入你想要的尺寸
 (if (= $$$k2 nil) (setq $$$k2 #k) );;如果不输入默认上一次输入
)
;;主程序;;;;
(defun C:TT6 ( / )
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (if (null vlax-dump-object) (vl-load-com) );;调用函数
 (if (= $$$k2 nil) (tt62) );;如果没有默认长度就要输入长度
 (tt64)
 (prin1)
);;以《C:TT6.lsp》命名