有人说，这个还不错

20060510412

请教黄大师，对于非封闭的图元，当向上投影的时候，得到上面的形状。
能否改为下面的形状呢？

LIULISHENG

真的不错   

自贡黄明儒

嘉伟钢结构 发表于 2022-12-12 12:09
老师：快捷命令是什么？

Ⅹ1    看c:后面，就是命令

20060510412

核心函数x11里面，全部是各种坐标系转换、角度换算、计算垂足之类的。
看了一会儿就云里雾里了。
黄大师的功力真是不一般。

想改代码，都无从改起。

panliang9

非常有意思！！！

llsheng_73

20060510412 发表于 2022-12-12 12:30
请教黄大师，对于非封闭的图元，当向上投影的时候，得到上面的形状。
能否改为下面的形状呢？

1. (vl-load-com)
   
2. (defun xyofen(e fun / p i pt n en)
   
3.   (or(=(type e)'ename)(setq e(vlax-vla-object->ename e)))
   
4.   (cond((vl-position'(0 . "LINE")(setq en(entget e)))
   
5.         (list(vlax-curve-getstartpoint e)(vlax-curve-getendpoint e)))
   
6.        ((WCMATCH(cdr(assoc 0 en))"*POLYLINE")
   
7.         (setq i -1 n(vlax-curve-getEndParam e))
   
8.         (while(< i n)
   
9.           (setq i(1+ i)p(vlax-curve-getPointAtParam e i))
   
10.           (or(equal(car pt)p fun)(setq pt(cons p pt))))
    
11.         (reverse pt))
    
12.        (t(vl-remove'nil(mapcar'(lambda(x)(cdr(assoc x en)))'(10 11 12 13 14))))))
    
13. (defun s2e(s / n lst)(if(=(type s)'pickset)(repeat(setq n(sslength s))(setq n(1- n)lst(cons(ssname s n)lst)))))
    
14. (defun PerLn(p p1 p2);;;点p到p1,p2所在直线垂距及垂足
    
15.   (setq p2(mapcar'- p1 p2))
    
16.   (list(abs(car(trans(mapcar'- p1 p) 0 p2)))
    
17.        (trans(mapcar'+(mapcar'*'(1 1 0)(trans p1 0 p2))(mapcar'*'(0 0 1)(trans p 0 p2)))p2 0)))
    
18. (defun delsame(l1 fuz / l2);;带容差去重(重复过的取第一次出现)
    
19.       (while l1(setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x fuz))(cdr l1))))
    
20.       (reverse l2))
    
21. (defun ScreenWid();;当前屏幕宽度
    
22.   (*(apply'/(getvar'screensize))(getvar'viewsize)))
    
23. (defun c:tt(/ s pt pts p o w ls)
    
24.   (while(setq s(s2e(ssget)))
    
25.     (and(setq a nil pt nil o(getpoint"指定参考线上一点"))
    
26.         (vl-every(function(lambda(x)(setq pt(cons(xyofen x 1e-3)pt))))s)
    
27.         (setq pts(delsame(apply(function append)pt)1e-3))
    
28.         (while(/=(car(mapcar(function set)'(a p)(grread 5)))3)(redraw)
    
29.           (setq ls nil)
    
30.           (if(= a 5)
    
31.             (progn
    
32.               (grdraw(polar o(angle p o)(setq w(ScreenWid)))(polar p(angle o p)w)5)
    
33.               (vl-some(function(lambda(x / q s)
    
34.                                  (setq q(cadr(PerLn x p o)))
    
35.                                  (or(vl-some(function(lambda(a)
    
36.                                                        (vl-some(function(lambda(a b / o)(and(setq o(inters x q a b))(not(equal x o 1e-3)))))a(cdr a))))pt)
    
37.                                     (grdraw x q 4)
    
38.                                     (setq ls(cons(list x q)ls)))nil))pts)))))
    
39.         (if(= a 3)(vl-every(function(lambda(x)(entmakex(list'(0 . "line")(cons 10(car x))(cons 11(cadr x))'(62 . 4)))))ls))
    
40.         ))

(vl-load-com)<br /> (defun xyofen(e fun / p i pt n en)<br />   (or(=(type e)'ename)(setq e(vlax-vla-object->ename e)))<br />   (cond((vl-position'(0 . "LINE")(setq en(entget e)))<br />         (list(vlax-curve-getstartpoint e)(vlax-curve-getendpoint e)))<br />        ((WCMATCH(cdr(assoc 0 en))"*POLYLINE")<br />         (setq i -1 n(vlax-curve-getEndParam e))<br />         (while(< i n)<br />           (setq i(1+ i)p(vlax-curve-getPointAtParam e i))<br />           (or(equal(car pt)p fun)(setq pt(cons p pt))))<br />         (reverse pt))<br />        (t(vl-remove'nil(mapcar'(lambda(x)(cdr(assoc x en)))'(10 11 12 13 14))))))<br /> (defun s2e(s / n lst)(if(=(type s)'pickset)(repeat(setq n(sslength s))(setq n(1- n)lst(cons(ssname s n)lst)))))<br /> (defun PerLn(p p1 p2);;;点p到p1,p2所在直线垂距及垂足<br />   (setq p2(mapcar'- p1 p2))<br />   (list(abs(car(trans(mapcar'- p1 p) 0 p2)))<br />        (trans(mapcar'+(mapcar'*'(1 1 0)(trans p1 0 p2))(mapcar'*'(0 0 1)(trans p 0 p2)))p2 0)))<br /> (defun delsame(l1 fuz / l2);;带容差去重(重复过的取第一次出现)<br />       (while l1(setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x fuz))(cdr l1))))<br />       (reverse l2))<br /> (defun ScreenWid();;当前屏幕宽度<br />   (*(apply'/(getvar'screensize))(getvar'viewsize)))<br /> (defun c:tt(/ s pt pts p o w ls)<br />   (while(setq s(s2e(ssget)))<br />     (and(setq a nil pt nil o(getpoint"指定参考线上一点"))<br />         (vl-every(function(lambda(x)(setq pt(cons(xyofen x 1e-3)pt))))s)<br />         (setq pts(delsame(apply(function append)pt)1e-3))<br />         (while(/=(car(mapcar(function set)'(a p)(grread 5)))3)(redraw)<br />           (setq ls nil)<br />           (if(= a 5)<br />             (progn<br />               (grdraw(polar o(angle p o)(setq w(ScreenWid)))(polar p(angle o p)w)5)<br />               (vl-some(function(lambda(x / q s)<br />                                  (setq q(cadr(PerLn x p o)))<br />                                  (or(vl-some(function(lambda(a)<br />                                                        (vl-some(function(lambda(a b / o)(and(setq o(inters x q a b))(not(equal x o 1e-3)))))a(cdr a))))pt)<br />                                     (grdraw x q 4)<br />                                     (setq ls(cons(list x q)ls)))nil))pts)))))<br />         (if(= a 3)(vl-every(function(lambda(x)(entmakex(list'(0 . "line")(cons 10(car x))(cons 11(cadr x))'(62 . 4)))))ls))<br />         ))

没有象黄老师那样搞自动参考线，需要自己通过两点确定参考方向，也没有计算所需要的参考线长度

紫苏炒黄瓜

自动辅助线

统一网名

确实不错，