求程序，将直线突出的部分减掉

c961806787 · 发表于 2013-11-4 12:55:28

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 c961806787 于 2013-11-4 12:59 编辑

如题，自己也写了一个，但效果不理想。谢谢指正。下面的动图是我无意中发现的，感觉对我很有用，没找到作者。功能：减掉突出的线头

;;轴线裁剪
(defun c:atr( / )
(vl-cmdf "undo" "be")
(CG:StoreSysVar)
;主程序开始
(vl-load-com)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(princ "\n选择需裁剪的轴线：")
(setq ss (ssget) nn (sslength ss) i 0 sslist '())
(repeat nn
(setq en0 (ssname ss i))
(setq pta (Vlax-Get (Vlax-Ename->Vla-Object en0) 'EndPoint)
ptb (Vlax-Get (Vlax-Ename->Vla-Object en0) 'StartPoint)
sslist (append (list (list en0 pta) (list en0 ptb)) sslist);所有直线端点的集合
go t j 0 mm (- nn 2)
)
(ssdel en0 ss)
(while (and go (<= j mm))
(setq en1 (ssname ss j))
(setq ptc (Vlax-Get (Vlax-Ename->Vla-Object en1) 'EndPoint)
ptd (Vlax-Get (Vlax-Ename->Vla-Object en1) 'StartPoint)
)
;;; (vl-cmdf "_.area" pta ptc ptd "")
;;; (setq #area (getvar 'area))
(if (and (equal (+ (distance pta ptc) (distance pta ptd)) (distance ptc ptd) 10) (/= (inters pta ptb ptc ptd t) nil))
(progn (vl-remove (list en0 pta) sslist) (setq go nil))
)
(setq j (1+ j))
)
(setq go t j 0)
(while (and go (<= j mm))
(setq en1 (ssname ss j))
(setq ptc (Vlax-Get (Vlax-Ename->Vla-Object en1) 'EndPoint)
ptd (Vlax-Get (Vlax-Ename->Vla-Object en1) 'StartPoint)
)
;;; (vl-cmdf "_.area" ptb ptc ptd "")
;;; (setq #area (getvar 'area))
(if (and (equal (+ (distance ptb ptc) (distance ptb ptd)) (distance ptc ptd) 10) (/= (inters pta ptb ptc ptd t) nil))
(progn (vl-remove (list en0 ptb) sslist) (setq go nil))
)
(setq j (1+ j))
)
(ssadd en0 ss)
(setq i (1+ i))
)
(setq nn_list (length sslist) k 0)
(repeat nn_list
(setq pt_bas (nth k sslist))
(vl-cmdf "_.trim" ss "e" "n" pt_bas "")
(setq k (1+ k))
)
;主程序结束
(vl-cmdf "_.undo" "e")
(princ "\n***完成！")
(CG:RestoreSysVar)
(prin1)
)
(prompt "\n***池工出品，精益求精！***")
(prin1)
;存储系统变量
(defun CG:StoreSysVar()
(setq vcmde (getvar "CMDECHO")) ;普通命令的提示
(setq vblip (getvar "blipmode")) ;光标痕迹
(setq vclay (getvar "CLAYER")) ;图层
(setq vosmo (getvar "osmode")) ;捕捉模式
(setq vplwd (getvar "plinewid")) ;pl宽度
(setq vlupr (getvar "luprec")) ;长度精度
)
;还原系统变量
(defun CG:RestoreSysVar()
(setvar "CMDECHO" vcmde)
(setvar "blipmode" vblip)
(setvar "CLAYER" vclay)
(setvar "osmode" vosmo)
(setvar "plinewid" vplwd)
(setvar "luprec" vlupr)
)
;错误处理
(defun *error* (msg)
(CG:RestoreSysVar)
(princ msg)
)

;;轴线裁剪 
(defun c:atr( / ) 
  (vl-cmdf "undo" "be") 
  (CG:StoreSysVar) 
    ;主程序开始 
  (vl-load-com) 
  (setvar 'cmdecho 0) 
  (setvar 'osmode 0) 
  (princ "\n选择需裁剪的轴线：") 
  (setq ss (ssget) nn (sslength ss) i 0 sslist '()) 
  (repeat nn 
    (setq en0 (ssname ss i)) 
    (setq pta (Vlax-Get (Vlax-Ename->Vla-Object en0) 'EndPoint) 
    ptb (Vlax-Get (Vlax-Ename->Vla-Object en0) 'StartPoint) 
    sslist (append (list (list en0 pta) (list en0 ptb)) sslist);所有直线端点的集合 
    go t j 0 mm (- nn 2) 
    ) 
    (ssdel en0 ss) 
    (while (and go (<= j mm)) 
      (setq en1 (ssname ss j)) 
      (setq ptc (Vlax-Get (Vlax-Ename->Vla-Object en1) 'EndPoint) 
      ptd (Vlax-Get (Vlax-Ename->Vla-Object en1) 'StartPoint) 
      ) 
;;;      (vl-cmdf "_.area" pta ptc ptd "") 
;;;      (setq #area (getvar 'area)) 
      (if (and (equal (+ (distance pta ptc) (distance pta ptd)) (distance ptc ptd) 10) (/= (inters pta ptb ptc ptd t) nil)) 
  (progn (vl-remove (list en0 pta) sslist) (setq go nil)) 
      ) 
      (setq j (1+ j)) 
    ) 
    (setq go t j 0) 
    (while (and go (<= j mm)) 
      (setq en1 (ssname ss j)) 
      (setq ptc (Vlax-Get (Vlax-Ename->Vla-Object en1) 'EndPoint) 
      ptd (Vlax-Get (Vlax-Ename->Vla-Object en1) 'StartPoint) 
      ) 
;;;      (vl-cmdf "_.area" ptb ptc ptd "") 
;;;      (setq #area (getvar 'area)) 
      (if (and (equal (+ (distance ptb ptc) (distance ptb ptd)) (distance ptc ptd) 10) (/= (inters pta ptb ptc ptd t) nil)) 
   (progn (vl-remove (list en0 ptb) sslist) (setq go nil)) 
    ) 
      (setq j (1+ j)) 
    ) 
    (ssadd en0 ss) 
    (setq i (1+ i)) 
  ) 
  (setq nn_list (length sslist) k 0) 
  (repeat nn_list 
    (setq pt_bas (nth k sslist)) 
    (vl-cmdf "_.trim" ss "e" "n" pt_bas "") 
    (setq k (1+ k)) 
  ) 
    ;主程序结束 
  (vl-cmdf "_.undo" "e") 
  (princ "\n***完成！") 
  (CG:RestoreSysVar) 
  (prin1) 
) 
(prompt "\n***池工出品，精益求精！***") 
(prin1) 
 
;存储系统变量 
(defun CG:StoreSysVar() 
  (setq vcmde (getvar "CMDECHO"))  ;普通命令的提示 
  (setq vblip (getvar "blipmode")) ;光标痕迹 
  (setq vclay (getvar "CLAYER"))   ;图层 
  (setq vosmo (getvar "osmode"))   ;捕捉模式 
  (setq vplwd (getvar "plinewid")) ;pl宽度 
  (setq vlupr (getvar "luprec"))   ;长度精度 
) 
;还原系统变量 
(defun CG:RestoreSysVar() 
  (setvar "CMDECHO" vcmde) 
  (setvar "blipmode" vblip) 
  (setvar "CLAYER" vclay) 
  (setvar "osmode" vosmo) 
  (setvar "plinewid" vplwd) 
  (setvar "luprec" vlupr) 
) 
;错误处理 
(defun *error* (msg) 
  (CG:RestoreSysVar) 
  (princ msg) 
)

Lisphk · 发表于 2013-11-4 14:20:14

我想，肯定离不开排序了。

ysq101 · 发表于 2013-11-4 15:44:48

我来围观楼主的毛毛虫的~~~~~~~

ysq101 · 发表于 2013-11-4 15:47:02

Lisphk 发表于 2013-11-4 14:20
我想，肯定离不开排序了。

一二楼对应了。。。。二楼只有膜拜的份了{:soso_e113:}

st788796 · 发表于 2013-11-4 15:52:23

论坛有过一个自动延伸裁剪可以参考

Lisper · 发表于 2013-11-4 19:09:24

原帖地址：
http://bbs.mjtd.com/thread-107831-2-1.html

游客，本帖隐藏的内容需要积分高于 30 才可浏览，您当前积分为 0

c961806787 · 发表于 2013-11-4 21:15:38

Lisper 发表于 2013-11-4 19:09
原帖地址：
http://bbs.mjtd.com/thread-107831-2-1.html
**** 本内容被作者隐藏 ****

找的我好苦！谢谢大神！{:soso_e113:}

wxytiger · 发表于 2013-11-7 09:34:48

Lisper 发表于 2013-11-4 19:09
原帖地址：
http://bbs.mjtd.com/thread-107831-2-1.html
**** 本内容被作者隐藏 ****

非常感谢，也在找这种程序。

xyp1964 · 发表于 2013-11-7 12:37:47

st788796 · 发表于 2013-11-7 12:50:45

求每个线和其它所有线的交点，交点集在曲线上按param排序，和startpoint endpoint 比较，按条件用movestretchpoint修改

st788796 · 发表于 2013-11-7 17:25:14

http://bbs.xdcad.net/thread-671470-1-1.html

xtdwynij · 发表于 2013-11-9 13:48:50

xyp1964 发表于 2013-11-7 12:37

院长高手！我也去看看！这功能蛮实用的！

账号		自动登录	找回密码
密码			立即注册

[求助] 求程序，将直线突出的部分减掉

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评

浏览过的版块