自由矩形（建模利器）

c961806787 · 发表于 2013-11-4 12:12:19

newer 发表于 2013-11-4 12:09
上面给你的第二个链接就是做你说的了。

如果你还有什么特别的需要，去编程申请发个帖子吧，详细说下要 ...

你的第二个程序是加的操作，我想要减的操作。就是要把突出来的直线减掉

newer · 发表于 2013-11-4 12:24:56

c961806787 发表于 2013-11-4 12:12
你的第二个程序是加的操作，我想要减的操作。就是要把突出来的直线减掉

道理是一样的，如果你懂代码，可以把里面的最大包围盒的部分去掉就是了，你的要求相对那个更容易些，

你去编程申请提交个帖子吧，说明下你的要求，抽空给你写个。

c961806787 · 发表于 2013-11-4 12:27:35

newer 发表于 2013-11-4 12:24
道理是一样的，如果你懂代码，可以把里面的最大包围盒的部分去掉就是了，你的要求相对那个更容易些，

...

你的代码不是cad的lisp的标准代码，应该是晓东API吧，着实看不懂。

c961806787 · 发表于 2013-11-4 12:32:15

newer 发表于 2013-11-4 12:24
道理是一样的，如果你懂代码，可以把里面的最大包围盒的部分去掉就是了，你的要求相对那个更容易些，

...

谢谢你啦。我也在写，就是老是不成功！能帮我看看代码吗？

;;轴线裁剪
(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) 
)

newer · 发表于 2013-11-4 12:37:42

c961806787 发表于 2013-11-4 12:27
你的代码不是cad的lisp的标准代码，应该是晓东API吧，着实看不懂。

API有函数手册，你要有写程序的基础，很容易掌握。用API写程序快，可以让你钻心用于算法实现上，想出来的，API基本都有函数去用，推荐你去学。事半功倍。

c961806787 · 发表于 2013-11-4 12:39:39

newer 发表于 2013-11-4 12:37
API有函数手册，你要有写程序的基础，很容易掌握。用API写程序快，可以让你钻心用于算法实现上，想出来的 ...

恩，谢谢，已经下载了！

h3161596 · 发表于 2013-11-5 01:57:32

挺好玩的收下了谢谢

1993063 · 发表于 2013-11-6 16:15:18

这个厉害！{:soso_e179:}

街角里的期待 · 发表于 2013-11-8 10:30:56

好厉害！

匿名 *发表于 2013-11-8 17:30:52* · 发表于 2013-11-8 17:30:52

太牛逼啦，能做三维对话框式调整吗、还有数据导出，零件图出图

dbx5511 · 发表于 2013-11-9 09:30:33

看看，学习一下。

sooner · 发表于 2013-11-15 15:01:25

强烈想看一看……

混沌初开 · 发表于 2013-11-17 17:14:57

这么厉害！前途无量啊！{:soso_e154:}

众山小 · 发表于 2013-11-19 11:23:28

还没有想好再哪里使用，不过确实不错！

大哥的未来 · 发表于 2013-11-21 15:49:09

经典值得拥有

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

[矩形] 自由矩形（建模利器）

点评

点评

点评

点评