作业帮 > 综合 > 作业

CAD lisp 如何实现直线指定长度位置打断?

来源:学生作业帮 编辑:搜搜做题作业网作业帮 分类:综合作业 时间:2024/06/23 14:05:06
CAD lisp 如何实现直线指定长度位置打断?
举例子有一条100mm长度的直线,我想实现输入定义好的命令后选择直线,然后输入长度30,则100直线会被打断成了、30+70的直线,切选择直线时点击了100偏向哪一端则30mm会在这一侧形成!
CAD lisp 如何实现直线指定长度位置打断?
(defun tes1 ( / &kw &kw1 %k1)
 (setq &kw (entsel "\n请选择要打断的直线"))
 (if (/= &kw nil)
  (progn
   (setq &kw1 (entget (car &kw)))
   (setq %k1 (cdr (assoc 0 &kw1)))
   (if (/= %k1 "LINE")
    (progn
     (alert "\n你选择的不是直线,请重新选择");;如不需要提示就删除这句话下同
     (setq &kw nil)
    )
   )
  )
 )
 &kw
)
(defun tes2 (&kw / L L2 #os #clayer @p1 &kw1 &kw #k1 @p2 @p3 %k1 %k2 %k #ang)
 (command "Lengthen" (car &kw) "")
 (setq L2 (getvar "perimeter"))
 (setq #os (getvar "osmode"))    ;;取得当前捕捉设置
 (setq #clayer (getvar "clayer"));;取得当前图层设置
 (setq @p1 (cadr &kw))           ;;取得直线捕捉点
 (setq &kw1 (car &kw))           ;;取得直线图元名
 (setq &kw (entget &kw1))        ;;取得直线属性列表
 (setq #k1 (cdr (assoc 8 &kw)))  ;;取得直线图层
 (setq @p2 (cdr (assoc 10 &kw))) ;;取得直线起点
 (setq @p3 (cdr (assoc 11 &kw))) ;;取得直线端点
 (setq %k1 (distance @p1 @p2))   ;;起点与捕捉点距离
 (setq %k2 (distance @p1 @p3))   ;;端点与捕捉点距离
 (setq %k (- %k1 %k2))           ;;两个距离相减
 (if (>= %k 0)                   ;;如果靠近端点
  (progn
   (setq #ang (angle @p3 @p2))   ;;取得这个角度
   (setq L (getdist @p3 (strcat "\n请输入要断点的长度(不大于直线长度:<" (rtos L2 2 2) ">)")))
   (if (/= L nil) (setq @p1 (polar @p3 #ang L))) ;;得到这个打断点
  )
 )
 (if (< %k 0)                    ;;如果靠近起点
  (progn
   (setq #ang (angle @p2 @p3))   ;;取得这个角度
   (setq L (getdist @p2 (strcat "\n请输入要断点的长度(不大于直线长度:<" (rtos L2 2 2) ">)")))
   (if (/= L nil) (setq @p1 (polar @p2 #ang L))) ;;得到打断点
  )
 )
 (if (= L nil) (alert "\n没有输入长度"))
 (if (and (/= L nil) (>= L L2)) (alert "\n错误,输入的长度大于等于直线的长度") )
 (if (and (/= L nil) (> L2 L))
  (progn
   (setvar "osmode" 0)
   (setvar "clayer" #k1)
   (command "LINE" @p2 @p1 "")
   (command "LINE" @p1 @p3 "")
   (entdel &kw1)
   (setvar "osmode" #os)
   (setvar "clayer" #clayer)
  )
 )
)
(defun C:tt1 ( / &kw)
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (setq &kw (tes1))
 (if (/= &kw nil) (tes2 &kw) )
 (prin1)
);;复制到记事本以(tt1.lsp)命名