xyp1964 发表于 2023-12-21 22:52
就是这样的，不知院长能否赐予源码， guosheyang 发表于 2023-12-21 22:42
让穿过拉伸面的曲线与曲面求交点然后 连接交点成线
，多谢指点，是好办法，我还有用将线压到时一个平面
求交点的方法，看来用面线求交，更方便。这个方法可以尝试一下。 断断续续的花了一些时间，好歹是写出来了，用的来是线压平，找交点的办法。不高级，凑合能用，还需要完善。另外在此也感谢回贴的各位师傅。 本帖最后由 Atsai 于 2023-12-24 07:48 编辑
zml84大大的一个以前分享的一个程序，
Z大当初只支援直线，版主修改一下应该可以满足。
;;网页抬头：在地形图上截断面（不完善，尚待改进）
;;2008-07-16 20:17
;;From zml84的blog
;;功能：在地形图上截断面
;;命令：dm
;;说明：
(vl-load-com)
(defun C:DM (/ M_OBJ1 M_ENT1 M_ENT2 M_JDTAB100)
(princ "\n请选择地形线:")
(setq
NUMBER
(getint
" 0=样条曲线; 1=多段线；2=样条曲线和多段线<默认0>:"
)
)
(cond
((= NUMBER 0) (setq SS (ssget '((0 . "SPLINE")))))
((= NUMBER 1) (setq SS (ssget '((0 . "*POLYLINE")))))
((= NUMBER 2) (setq SS (ssget '((0 . "*POLYLINE,SPLINE")))))
(t (setq SS (ssget '((0 . "SPLINE")))))
)
;;
(if (and SS
(setq OBJ_0 (entsel "\n请选择剖面线: "))
(= (cdr (assoc 0 (entget (car OBJ_0)))) "LINE") ;_目前只支持直线段
)
(progn
;;转化对象类型
(setq OBJ_0 (vlax-ename->vla-object (car OBJ_0)))
;;获取交点
(setq LST_PT '()
I 0
)
(repeat (sslength SS)
(setq OBJ_1(vlax-ename->vla-object (ssname SS I))
TMP (ZL-GETINTERS OBJ_0 OBJ_1 0 "F2" NIL)
LST_PT (append TMP LST_PT)
)
(setq I (1+ I))
)
;; 排序
;; 点表按照xyz从小到大排序
(setq LST_PT (vl-sort LST_PT
'(lambda (P1 P2)
(< (cadr P1) (cadr P2))
)
)
LST_PT (vl-sort LST_PT
'(lambda (P1 P2)
(< (car P1) (car P2))
)
)
)
;;绘制
(command "_.3dpoly")
(foreach PT LST_PT
(command "non" PT)
)
(command "")
;;显示
(foreach PT LST_PT
(princ PT)
)
(princ "程序完毕")
)
)
(princ)
)
;;;=============================================================================
;|;;===========================================================================
通用函数 ;
功能：求两个线条对象的交点 ;
适用对象: Line、Circle、Arc、Ellipse、Polyline、 ;
LWPolyline、3dPolyline、Spline ;
参数：OBJ1 ----对象1 ;
OBJ2 ----对象2 ;
Extend ----延伸选项 ;
0acExtendNone ;
1acExtendThisEntity ;
2acExtendOtherEntity ;
3acExtendBoth ;
ZZZ ----输出选项 ;
"=0"Z值取0 ;
"F1"取第一个对象上的点 ;
"F2"取第二个对象上的点 ;
"MAX" 取Z值大者 ;
"MIN" 取Z值小者 ;
Fuzz ----允许偏差值 ;
返回：若成功，返回点位表；否则返回nil
日期：zml84 于2007-11-05
;;|;
(vl-load-com)
(defun ZL-GETINTERS (OBJ1 OBJ2 EXTEND ZZZFUZZ / ENT1
ENT2 PT10 PT11 PT20PT21 OBJ11OBJ22
ARRAYLST LST_PT IPT PT1 PT2
Z1 Z2
)
;;0、对参数的格式化处理
(if (and (= (type EXTEND) 'INT)
(<= 0 EXTEND 3)
)
()
(setq EXTEND 0)
)
(setq ZZZ (strcase ZZZ))
;;======================
;;1、获取交点集合>>>>>>>
(if (and (= (vla-get-objectname OBJ1) "AcDbLine")
(= (vla-get-objectname OBJ2) "AcDbLine")
)
;;对直线对象(line) 特别处理
(progn
(setq ENT1 (entget (vlax-vla-object->ename OBJ1))
ENT2 (entget (vlax-vla-object->ename OBJ2))
)
(setq PT10 (assoc 10 ENT1)
PT11 (assoc 11 ENT1)
PT20 (assoc 10 ENT2)
PT21 (assoc 11 ENT2)
)
;;去除Z坐标
(setq PT10 (list (cadr PT10) (caddr PT10))
PT11 (list (cadr PT11) (caddr PT11))
PT20 (list (cadr PT20) (caddr PT20))
PT21 (list (cadr PT21) (caddr PT21))
)
(setq LST (inters PT10 PT11 PT20 PT21 t))
(if LST
(setq LST (append LST '(0)))
)
)
(progn
;;=====================
;;复制实体
(setq OBJ11 (vla-copy OBJ1)
OBJ22 (vla-copy OBJ2)
)
;;向xy平面投影，将Z坐标改为0
(TOXY OBJ11)
(TOXY OBJ22)
;;获取交点集合
(setq ARRAY (vla-intersectwith OBJ11 OBJ22 EXTEND))
;;删除复制后的对象
(vla-delete OBJ11)
(vla-delete OBJ22)
;;由数组转换为表
(if (and ARRAY
(> (vlax-safearray-get-u-bound
(vlax-variant-value ARRAY)
1
)
1
)
)
(progn
(setq LST (vlax-safearray->list
(vlax-variant-value ARRAY)
)
)
)
)
)
)
;;======================
;;2、分析整理>>>>>>>
(setq LST_PT '())
(if LST
(progn
(setq I 0)
(repeat (/ (length LST) 3)
;;2.1 获取当前点位
(setq PT (list (nth I LST)
(nth (+ 1 I) LST)
(nth (+ 2 I) LST)
)
)
;;2.2 获取对象上对应点位
(setq PT1 (vlax-curve-getclosestpointtoprojection
OBJ1
PT
'(0 0 1)
)
PT2 (vlax-curve-getclosestpointtoprojection
OBJ2
PT
'(0 0 1)
)
)
(setq Z1 (caddr PT1)
Z2 (caddr PT2)
)
;;2.3 效验偏差值
;;就是说：过滤:参数中有偏差值选项，却不满足要求的点位
(if (and FUZZ
(or (= (type FUZZ) 'REAL)
(= (type FUZZ) 'INT)
)
(not (equal Z1 Z2 FUZZ))
)
;; 空处理
()
;;2.4 对输出选项的处理
(progn
(cond
((= ZZZ "F1")
(setq PT PT1)
)
((= ZZZ "F2")
(setq PT PT2)
)
((= ZZZ "MAX")
(if (> Z1 Z2)
(setq PT PT1)
(setq PT PT2)
)
)
((= ZZZ "MIN")
(if (< Z1 Z2)
(setq PT PT1)
(setq PT PT2)
)
)
(t
(setq PT PT)
)
) ;_结束cond
(if (member PT LST_PT)
()
(setq LST_PT (cons PT LST_PT))
)
) ;_结束progn
) ;_结束if
(setq I (+ I 3))
) ;_结束repeat
) ;_结束progn
) ;_结束if
;;3、返回结果>>>>>
LST_PT
) ;_结束defun
;;;============================================================
;;;功能：曲线实体上每个控制点的z坐标值置为0.0
(defun TOXY (OBJ / NAME PT1 TP2)
;;取得实体的类型名称
(setq NAME (vla-get-objectname OBJ))
(cond
;;类型1
;;直线(line)
((= NAME "AcDbLine")
;;取得直线的起终点坐标
(setq PT1 (vlax-variant-value (vla-get-startpoint OBJ))
PT2 (vlax-variant-value (vla-get-endpoint OBJ))
)
;;改变z值为0.0
(vlax-safearray-put-element PT1 2 0.0)
(vlax-safearray-put-element PT2 2 0.0)
(vla-put-startpoint OBJ PT1)
(vla-put-endpoint OBJ PT2)
)
;;类型2
;;圆(circle)
;;圆弧(arc)
;;椭圆及椭圆弧(ellipse)
((or (= NAME "AcDbCircle")
(= NAME "AcDbArc")
(= NAME "AcDbEllipse")
)
;;取得中心点座标
(setq PT1 (vlax-variant-value (vla-get-center OBJ)))
;;改变中心点座标z值为0.0
(vlax-safearray-put-element PT1 2 0.0)
(vla-put-center OBJ PT1)
)
;;类型3
;;多段线(polyline、lwpolyline)
;;拟合的2维多段线(polyline、lwpolyline)
((or (= NAME "AcDbPolyline")
(= NAME "AcDb2dPolyline")
)
;;改变标高值为0.0
(vla-put-elevation OBJ 0.0)
)
;;类型4
;;三维多段线(3dpolyline)
((= NAME "AcDb3dPolyline")
;;取得3维多段线的控制点
(setq PT1 (vlax-variant-value (vla-get-coordinates OBJ))
I 0
)
(repeat (/ (length (vlax-safearray->list PT1)) 3)
(vlax-safearray-put-element PT1 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-coordinates OBJ PT1)
)
;;类型5
;;样条曲线(Spline)
((= NAME "AcDbSpline")
;;取得样条曲线的拟合点
;;改变每个拟合点的z值为0.0
(setq PT1 (vlax-variant-value (vla-get-fitpoints OBJ))
I 0
)
(repeat (vla-get-numberoffitpoints OBJ)
(vlax-safearray-put-element PT1 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-fitpoints OBJ PT1)
;;取得样条曲线的控制点
;;改变每个控制点的z值为0.0
(setq
PT2 (vlax-variant-value (vla-get-controlpoints OBJ))
I0
)
(repeat (vla-get-numberofcontrolpoints OBJ)
(vlax-safearray-put-element PT2 (+ I 2) 0.0)
(setq I (+ I 3))
)
(vla-put-controlpoints OBJ PT2)
)
(t NIL)
)
) ;_结束defun Atsai 发表于 2023-12-24 07:47
zml84大大的一个以前分享的一个程序，
Z大当初只支援直线，版主修改一下应该可以满足。
研究一下，谢谢
有点意思，点的排序也能正确生成了。
这个可以玩一个下午，
自已可以收回明经币吗:lol
页:
1
[2]