曲线展点

Gray-wolf

(defun c:zd (/ en en_obj gd len len_lst obj pt pt_x pt_y pt1 pts ss ss1_lst)       
        (vl-load-com)   
        (setq eh-*error*-bak *error*)
        (defun *error* (msg)
                (setq *error* eh-*error*-bak)
                (setvar "osmode" eh_os_g)
                (vla-endundomark eh_doc_g)
                (setvar "nomutt" 0)
                (setvar "cmdecho" 1)
                (print msg)
        )
       
        (setvar "cmdecho" 0)
        (if (null eh_doc_g)(setq eh_doc_g (vla-get-activedocument (vlax-get-acad-object))))
        (vla-startundomark eh_doc_g)
        (if (< (setq eh_os_g (getvar "osmode")) 16384)
                (setvar "osmode" (+ eh_os_g 16384))
        )
       
        (setq ss (ssget))
        (setq en (ssname ss 0))
        (setq en_obj (vlax-ename->vla-object en))
        (setq ss1_lst (EH-SS->List (ssget)))
        (setq ss1_lst (vl-remove en ss1_lst))
        ;;闭合对象取结束端点时出现长度0,所以取用参数来取长度       
        (setq len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
        ;;求出交点集
        (setq pts '())       
        (foreach x ss1_lst
                (setq obj (vlax-ename->vla-object x))                       
                (setq pt (vla-IntersectWith en_obj obj acExtendNone))               
                (setq pt (vlax-variant-value pt))               
                (if (= -1 (vlax-safearray-get-u-bound pt 1))
                        nil
                        (progn
                                (setq pt (vlax-safearray->list pt))
                                ;;如果交点在顶点上有可能会出错
                                ;;(1.41138e+006 43846.0 0.0 1.41138e+006 43846.0 0.0)
                                (cond
                                        ((= (length pt) 3) (setq pts (cons pt pts)))
                                        ((> (length pt) 3)
                                                (setq ls_lst nil)
                                                (while (car pt)
                                                        (setq ls_lst (cons (list (car pt) (cadr pt) (caddr pt)) ls_lst))
                                                        (setq pt (cdr (cdr (cdr pt))))                                                       
                                                )
                                                (foreach x ls_lst
                                                        (setq pts (cons x pts))                                                       
                                                )
                                        )
                                        (T nil)                                       
                                )                                       
                        )       
                )               
        )
       
        ;;求曲线上起点到各交点的长度并排序
        (setq len_lst '())
        (setq len_lst (cons len len_lst))       
        (foreach x pts               
                (setq len (vlax-curve-getDistAtPoint en x))
                (setq len_lst (cons len len_lst))               
        )
        (setq len_lst
                (vl-sort len_lst '(lambda (a b) (< a b)))               
        )
       
        (if len_lst
                (progn
               
                        (if (= eh_wall_gd_g nil)
                                (setq eh_wall_gd_g 2900))
                        (princ "\n请输入墙高<")(princ eh_wall_gd_g)(princ ">:")  ;;显示默认墙高
                        (setq gd (getdist))
                        (if (= gd nil)
                                (setq gd eh_wall_gd_g)
                                (setq eh_wall_gd_g gd))
                       
                       
                       
                       
                        (setvar "osmode" eh_os_g)
                        (setq pt1 (getpoint "请指定墙料插入点："))
                                               
                        (if (< (setq eh_os_g (getvar "osmode")) 16384)
                                (setvar "osmode" (+ eh_os_g 16384))
                        )                       
                        (setq pt_X (car pt1))
                        (setq pt_Y (cadr pt1))
                       
                        (setq pts (list
                                                                        pt1
                                                                        (list (+ pt_X (last len_lst)) pt_Y)
                                                                        (list (+ pt_X (last len_lst)) (+ pt_Y gd))
                                                                        (list pt_X (+ pt_Y gd))
                                                                )                               
                        )
                        (EH-Make-Lwpolyline pts nil T nil nil)
                       
                        (setq len_lst (reverse (cdr (reverse len_lst))))
                       
                        (foreach x len_lst
                                (setq pts (list
                                                                                (list (+ pt_X x) pt_Y)
                                                                                (list (+ pt_X x) (+ pt_Y gd))                                                                                                                                                                                                                                                                                                                                                                                                       
                                                                        )                                       
                                )
                                (EH-Make-Lwpolyline pts nil nil nil nil)                                                               
                        )                                               
                )
        )
       
        (setq *error* eh-*error*-bak)
        (setvar "osmode" eh_os_g)
        (vla-endundomark eh_doc_g)
        (setvar "nomutt" 0)
        (setvar "cmdecho" 1)   
        (princ)
);defun_end

lisperado

暂时用 EXPRESS TOOL代替看看？
(setq EH-SS->List   ACET-SS-TO-LIST)

EH-Make-Lwpolyline这函数需要5个参数所以没办法帮
如果用普通线看看结果是什么？

1. (defun Make-Lwpolyline (lst)
   
2.     (entmake (vl-list*        '(0 . "LWPOLYLINE")
   
3.                         '(100 . "AcDbEntity")
   
4.                         '(100 . "AcDbPolyline")
   
5.                         '(70 . 0)
   
6.                         (cons 90 (length lst))
   
7.                         (mapcar '(lambda (x) (cons 10 x)) lst)
   
8.                         )
   
9.               )
   
10.   )
    

(defun Make-Lwpolyline (lst)<br />     (entmake (vl-list*        '(0 . "LWPOLYLINE")<br />                         '(100 . "AcDbEntity")<br />                         '(100 . "AcDbPolyline")<br />                         '(70 . 0)<br />                         (cons 90 (length lst))<br />                         (mapcar '(lambda (x) (cons 10 x)) lst)<br />                         ) <br />               )<br />   )<br />

；搜索放弃应用无知EH-函数
(EH-Make-Lwpolyline pts nil nil nil nil)

；改普通线看看
(make-Lwpolyline pts)   

lisperado

可能你没安装ET?
虽然没有EH-SS->List函数也不清楚其功能，所以只能猜测罢了！
只有要求版主重发！

试试另一个函数？请先置顶看看

1. (defun ss->lst ( s / e)
   
2. (if (and s (setq e (ssname s 0))) (cons e (ss->lst (ssdel e s)))))

(defun ss->lst ( s / e)<br /> (if (and s (setq e (ssname s 0))) (cons e (ss->lst (ssdel e s)))))

(setq EH-SS->List   ss->lst)

预知幸福

fangmin723 发表于 2018-6-4 07:50
缺少自定义函数：EH-SS->List和EH-Make-Lwpolyline

可以上传缺少的自定义函数：EH-SS->List和EH-Make-Lwpolyline吗

fangmin723

缺少自定义函数：EH-SS->List和EH-Make-Lwpolyline

fangmin723

预知幸福 发表于 2018-10-6 10:38
可以上传缺少的自定义函数：EH-SS->List和EH-Make-Lwpolyline吗

这个程序不是我写的，这两个函数我没有!

预知幸福

用不了 可以把完整的代码补全吗

预知幸福

用不了 可以把完整的代码补全吗

预知幸福

用不了 可以把代码补全吗

hhh454

感觉楼主的代码用建筑模型绘图

预知幸福

hhh454 发表于 2018-10-8 16:55
感觉楼主的代码用建筑模型绘图

可以用在建筑模型绘图