多段线椭圆样条曲线跟踪描绘怎么做？如图效果？

树櫴希德

多段线椭圆样条曲线跟踪描绘怎么做？如图效果？效果在压缩文件里面，因为大于3.9兆 了😭

XDSoft

使用ACGE几何库，setinterval

例子：

• XDGE几何库应用(九) ---抠出曲线内的部分
  4 个回复 - 1553 次查看
  ARX函数原型 AcGeNurbCurve3d::hardTrimByParams Function AcGeNurbCurve3d &hardTrimByParams(double newStartParam,double newEndParam);使用新的起点和终点参数裁剪样条曲线。这通过添加和删除控制点和节点,而不 ...
  2014-9-19 12:24 - XDSoft - XDRX_API应用
  
  

• XDGE几何库应用(四) -- Ge 曲线 Interval 上下限查询
  3 个回复 - 2487 次查看
  用来查询各类 Ge 曲线的 Interval 区间 命令: tt 选择对象: 指定对角点: 找到 10 个 选择对象: 指定对角点: 找到 2 个 (1 个重复)，总计 11 个 选择对象: AcGe Type = kLine3d （xline） Interval lowerBound = ...
  2014-9-16 01:32 - st788796 - XDRX_API应用
  
  

• XDGE几何库应用(12)--多义线局部整段偏移
  8 个回复 - 1688 次查看
  较为综合应用
  2014-9-21 21:14 - st788796 - XDRX_API应用
• • XDGE几何库应用 ---获取曲线重叠段
    5 个回复 - 1492 次查看
    ARX功能强大，尤其是其中的AcGe几何库，最近研究了下，有些心得 下面探讨如何获得两条曲线重叠的部分 几何库里面有个类 AcGeCurveCurveInt3d，这个类就是处理两条相交曲线的各种位置关系的，其中 1、overlapCoun ...
    2017-2-13 12:57 - Lispboy - XDRX_API应用
    
    
  
  

树櫴希德

这种效果LISP如何实现？

/db_自贡黄明儒_

就样条曲线比较麻烦，所以最简单的办法就是拷贝+剪切。

树櫴希德

/db_自贡黄明儒_ 发表于 2024-8-9 07:45
就样条曲线比较麻烦，所以最简单的办法就是拷贝+剪切。

伪源码

1. ;21、绘截描线
   
2. (defun c:hjmx ( / catch e1 e2 ent ex fz getfun ls ob ob1 obs okp p1 p2 pLst pn poly ps psx ss tp tps)
   
3.         (defun getfun ()
   
4.                 (if p1
   
5.                         (progn (initget "C H U") (setq p2 (getpoint "\n指定下一个点[闭合(C)/描边与直线切换(H)/放弃(U)]<退出>：" p1)))
   
6.                         (progn (initget "S") (setq p1 (getpoint (strcat "\n请指定'绘截描线'的起点[设置(S)]<退出>："))))
   
7.                 )
   
8.                 (setq psx (list p1 p2) p1 (car psx) p2 (cadr psx))
   
9.         )
   
10.         ; 主程序
    
11.         (setq tps '("LWPOLYLINE" "CIRCLE" "ARC" "ELLIPSE") fz 0.03 p1 nil p2 nil e1 nil e2 nil
    
12.                         ps nil pLst nil ob nil obs nil okp t poly nil ; pLst为'((p1 p2 e1 e2 ob) ...)
    
13.         )
    
14.         (while (and okp (setq catch (vl-catch-all-apply 'getfun nil)))
    
15.                 (if (and catch (not (vl-catch-all-error-p catch)))
    
16.                         (progn
    
17.                                 (if (and p2 (listp p2) p1  (< (distance p1 p2) fz))  (progn (setq p2 nil) (princ "\n距离太近，无效点！")))
    
18.                                 (cond
    
19.                                         ((and p1 (listp p1) (not p2))
    
20.                                                 (if (and (setq ent (nentselp p1)) (setq e1 (car ent) tp (En-GetProp* e1 0)) (vl-position tp tps))
    
21.                                                         (setq p1 (cadr ent) ex (sssetfirst nil (Data-ToSs* e1))) ; (nentselp (getpoint))
    
22.                                                         (setq e1 nil)
    
23.                                                 )
    
24.                                                 (setq ps (cons p1 ps) pLst (cons (list p1 p2 e1 e2 ob) pLst))
    
25.                                         )
    
26.                                         ((and p2 (listp p2) p1)
    
27.                                                 (if (and (setq ent (nentselp p2)) (setq e2 (car ent) tp (En-GetProp* e2 0)) (vl-position tp tps))
    
28.                                                         (progn
    
29.                                                                 (sssetfirst nil nil) ; 清除之前的选择
    
30.                                                                 (setq p2 (cadr ent) ex (sssetfirst nil (Data-ToSs* e2))) ; (nentselp (getpoint))
    
31.                                                                 (if (and e1 (equal e1 e2))
    
32.                                                                         (setq ob (Curve-PartCopy* e1 p1 p2)) ; 在同一条曲线上 要描边
    
33.                                                                         (setq ob (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线
    
34.                                                                 )
    
35.                                                         ) ; (getpoint p1) (getpoint p2)  (Else-TestPts* ps) (length ps) (length pLst) (setq ps nil)
    
36.                                                         (setq e2 nil ob (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线
    
37.                                                 )
    
38.                                                 (setq ps (cons p2 ps) obs (cons ob obs) pLst (cons (list p1 p2 e1 e2 ob) pLst) p1 p2 e1 e2)
    
39. ;                                                (if (> n 1) (setq sso (cadr (ssgetfirst)))) ; 获取并保留之前的选择
    
40. ;                                                (sssetfirst nil nil) ; 清除之前的选择
    
41. ;                                                (sssetfirst nil (Ss-Union* sso ss)) ; 夹点显示
    
42.                                         )
    
43.                                         ((= p1 "S") ; 只能最开始设置一次
    
44.                                                 (princ "\n暂未添加设置信息，后续增加，谢谢！")
    
45.                                                 (princ)
    
46.                                         )
    
47.                                 )
    
48.                                 (cond
    
49.                                         ((and (> (length obs) 1) (= p2 "C")) ; 闭合并退出 并 校对悬挂点
    
50.                                                 (setq okp nil ss (cadr (ssgetfirst))) ; (sssetfirst nil ss) (sslength ss)
    
51. ;                                                (setq poly (car (Poly-Joina* obs t t nil nil nil))) ; (Poly-Joina* enobss polyp delp lay litp c)
    
52.                                                 (setq poly (Cmd-JionToPoly* (Data-ToSs* obs) fz))
    
53.                                                 (Ob-MdfProp* poly "Closed" -1)
    
54. ;                                                (sssetfirst nil nil) ; 清除之前的选择
    
55.                                         )
    
56.                                         ((and e1 (equal e1 e2) (= p2 "H")) ; 切换
    
57.                                                 (setq ls (car pLst) p1 (car ls) p2 (cadr ls) ob (nth 4 ls)) ; (getpoint p1) (getpoint p2)
    
58.                                                 (if (= (vlax-Get ob "ObjectName") "AcDbLine")
    
59.                                                         (setq ob1 (Curve-PartCopy* e1 p1 p2)) ; 在同一条曲线上 要描边
    
60.                                                         (setq ob1 (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线
    
61.                                                 )
    
62.                                                 (vlax-Invoke ob "Delete") ; 删除当前线
    
63.                                                 (setq ob ob1 obs (cdr obs) obs (cons ob obs) pLst (cdr pLst) pLst (cons (list p1 p2 e1 e2 ob) pLst) p1 p2)
    
64.                                         )
    
65.                                         ((and p1 p2 ps pn (= p2 "U")) ; 撤销
    
66.                                                 (setq ls (car pLst) p1 (car ls) p2 (cadr ls) e1 (caddr ls) e2 (nth 3 ls) ob (nth 4 ls))
    
67.                                         )
    
68.                                 )
    
69.                         )
    
70.                 )
    
71.         )
    
72.         (if (and (not poly) (> (length obs) 1))
    
73.                 (setq poly (Cmd-JionToPoly* (Data-ToSs* obs) fz)) ; (setq poly (car (Poly-Joinv* obs t t nil nil nil)))
    
74.         )
    
75.         (setq ex (sssetfirst nil nil) getfun nil) ; 清除之前的选择，清除子函数
    
76.         (princ "\n'绘截描线'完毕，感谢使用!")
    
77.         (princ)
    
78. )

;21、绘截描线<br /> (defun c:hjmx ( / catch e1 e2 ent ex fz getfun ls ob ob1 obs okp p1 p2 pLst pn poly ps psx ss tp tps)<br />         (defun getfun ()<br />                 (if p1<br />                         (progn (initget "C H U") (setq p2 (getpoint "\n指定下一个点[闭合(C)/描边与直线切换(H)/放弃(U)]<退出>：" p1)))<br />                         (progn (initget "S") (setq p1 (getpoint (strcat "\n请指定'绘截描线'的起点[设置(S)]<退出>："))))<br />                 )<br />                 (setq psx (list p1 p2) p1 (car psx) p2 (cadr psx))<br />         )<br />         ; 主程序<br />         (setq tps '("LWPOLYLINE" "CIRCLE" "ARC" "ELLIPSE") fz 0.03 p1 nil p2 nil e1 nil e2 nil<br />                         ps nil pLst nil ob nil obs nil okp t poly nil ; pLst为'((p1 p2 e1 e2 ob) ...)<br />         )<br />         (while (and okp (setq catch (vl-catch-all-apply 'getfun nil)))<br />                 (if (and catch (not (vl-catch-all-error-p catch)))<br />                         (progn<br />                                 (if (and p2 (listp p2) p1  (< (distance p1 p2) fz))  (progn (setq p2 nil) (princ "\n距离太近，无效点！")))<br />                                 (cond<br />                                         ((and p1 (listp p1) (not p2))<br />                                                 (if (and (setq ent (nentselp p1)) (setq e1 (car ent) tp (En-GetProp* e1 0)) (vl-position tp tps))<br />                                                         (setq p1 (cadr ent) ex (sssetfirst nil (Data-ToSs* e1))) ; (nentselp (getpoint))<br />                                                         (setq e1 nil)<br />                                                 )<br />                                                 (setq ps (cons p1 ps) pLst (cons (list p1 p2 e1 e2 ob) pLst))<br />                                         )<br />                                         ((and p2 (listp p2) p1)<br />                                                 (if (and (setq ent (nentselp p2)) (setq e2 (car ent) tp (En-GetProp* e2 0)) (vl-position tp tps))<br />                                                         (progn<br />                                                                 (sssetfirst nil nil) ; 清除之前的选择<br />                                                                 (setq p2 (cadr ent) ex (sssetfirst nil (Data-ToSs* e2))) ; (nentselp (getpoint))<br />                                                                 (if (and e1 (equal e1 e2))<br />                                                                         (setq ob (Curve-PartCopy* e1 p1 p2)) ; 在同一条曲线上 要描边<br />                                                                         (setq ob (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线<br />                                                                 )<br />                                                         ) ; (getpoint p1) (getpoint p2)  (Else-TestPts* ps) (length ps) (length pLst) (setq ps nil)<br />                                                         (setq e2 nil ob (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线<br />                                                 )<br />                                                 (setq ps (cons p2 ps) obs (cons ob obs) pLst (cons (list p1 p2 e1 e2 ob) pLst) p1 p2 e1 e2)<br /> ;                                                (if (> n 1) (setq sso (cadr (ssgetfirst)))) ; 获取并保留之前的选择<br /> ;                                                (sssetfirst nil nil) ; 清除之前的选择<br /> ;                                                (sssetfirst nil (Ss-Union* sso ss)) ; 夹点显示<br />                                         )<br />                                         ((= p1 "S") ; 只能最开始设置一次<br />                                                 (princ "\n暂未添加设置信息，后续增加，谢谢！")<br />                                                 (princ)<br />                                         )<br />                                 )<br />                                 (cond<br />                                         ((and (> (length obs) 1) (= p2 "C")) ; 闭合并退出 并 校对悬挂点<br />                                                 (setq okp nil ss (cadr (ssgetfirst))) ; (sssetfirst nil ss) (sslength ss)<br /> ;                                                (setq poly (car (Poly-Joina* obs t t nil nil nil))) ; (Poly-Joina* enobss polyp delp lay litp c)<br />                                                 (setq poly (Cmd-JionToPoly* (Data-ToSs* obs) fz))<br />                                                 (Ob-MdfProp* poly "Closed" -1)<br /> ;                                                (sssetfirst nil nil) ; 清除之前的选择<br />                                         )<br />                                         ((and e1 (equal e1 e2) (= p2 "H")) ; 切换<br />                                                 (setq ls (car pLst) p1 (car ls) p2 (cadr ls) ob (nth 4 ls)) ; (getpoint p1) (getpoint p2)<br />                                                 (if (= (vlax-Get ob "ObjectName") "AcDbLine")<br />                                                         (setq ob1 (Curve-PartCopy* e1 p1 p2)) ; 在同一条曲线上 要描边<br />                                                         (setq ob1 (vlax-Invoke *Model* "AddLine" p1 p2)) ; 绘制直线<br />                                                 )<br />                                                 (vlax-Invoke ob "Delete") ; 删除当前线<br />                                                 (setq ob ob1 obs (cdr obs) obs (cons ob obs) pLst (cdr pLst) pLst (cons (list p1 p2 e1 e2 ob) pLst) p1 p2)<br />                                         )<br />                                         ((and p1 p2 ps pn (= p2 "U")) ; 撤销<br />                                                 (setq ls (car pLst) p1 (car ls) p2 (cadr ls) e1 (caddr ls) e2 (nth 3 ls) ob (nth 4 ls))<br />                                         )<br />                                 )<br />                         )<br />                 )<br />         )<br />         (if (and (not poly) (> (length obs) 1))<br />                 (setq poly (Cmd-JionToPoly* (Data-ToSs* obs) fz)) ; (setq poly (car (Poly-Joinv* obs t t nil nil nil)))<br />         )<br />         (setq ex (sssetfirst nil nil) getfun nil) ; 清除之前的选择，清除子函数<br />         (princ "\n'绘截描线'完毕，感谢使用!")<br />         (princ)<br /> )