20060510412 发表于 2022-12-12 12:30:04


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

LIULISHENG 发表于 2022-12-12 12:47:28

真的不错   

自贡黄明儒 发表于 2022-12-12 18:23:13

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

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

20060510412 发表于 2022-12-12 23:15:50

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

想改代码，都无从改起。:L

panliang9 发表于 2022-12-13 08:44:13

非常有意思！！！

llsheng_73 发表于 2022-12-13 17:23:18

本帖最后由 llsheng_73 于 2022-12-13 17:53 编辑

20060510412 发表于 2022-12-12 12:30
请教黄大师，对于非封闭的图元，当向上投影的时候，得到上面的形状。
能否改为下面的形状呢？
(vl-load-com)
(defun xyofen(e fun / p i pt n en)
(or(=(type e)'ename)(setq e(vlax-vla-object->ename e)))
(cond((vl-position'(0 . "LINE")(setq en(entget e)))
      (list(vlax-curve-getstartpoint e)(vlax-curve-getendpoint e)))
       ((WCMATCH(cdr(assoc 0 en))"*POLYLINE")
      (setq i -1 n(vlax-curve-getEndParam e))
      (while(< i n)
          (setq i(1+ i)p(vlax-curve-getPointAtParam e i))
          (or(equal(car pt)p fun)(setq pt(cons p pt))))
      (reverse pt))
       (t(vl-remove'nil(mapcar'(lambda(x)(cdr(assoc x en)))'(10 11 12 13 14))))))
(defun s2e(s / n lst)(if(=(type s)'pickset)(repeat(setq n(sslength s))(setq n(1- n)lst(cons(ssname s n)lst)))))
(defun PerLn(p p1 p2);;;点p到p1,p2所在直线垂距及垂足
(setq p2(mapcar'- p1 p2))
(list(abs(car(trans(mapcar'- p1 p) 0 p2)))
       (trans(mapcar'+(mapcar'*'(1 1 0)(trans p1 0 p2))(mapcar'*'(0 0 1)(trans p 0 p2)))p2 0)))
(defun delsame(l1 fuz / l2);;带容差去重(重复过的取第一次出现)
      (while l1(setq l2(cons(car l1)l2)l1(vl-remove-if'(lambda (x)(equal(car l1)x fuz))(cdr l1))))
      (reverse l2))
(defun ScreenWid();;当前屏幕宽度
(*(apply'/(getvar'screensize))(getvar'viewsize)))
(defun c:tt(/ s pt pts p o w ls)
(while(setq s(s2e(ssget)))
    (and(setq a nil pt nil o(getpoint"指定参考线上一点"))
      (vl-every(function(lambda(x)(setq pt(cons(xyofen x 1e-3)pt))))s)
      (setq pts(delsame(apply(function append)pt)1e-3))
      (while(/=(car(mapcar(function set)'(a p)(grread 5)))3)(redraw)
          (setq ls nil)
          (if(= a 5)
            (progn
            (grdraw(polar o(angle p o)(setq w(ScreenWid)))(polar p(angle o p)w)5)
            (vl-some(function(lambda(x / q s)
                                 (setq q(cadr(PerLn x p o)))
                                 (or(vl-some(function(lambda(a)
                                                       (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)
                                    (grdraw x q 4)
                                    (setq ls(cons(list x q)ls)))nil))pts)))))
      (if(= a 3)(vl-every(function(lambda(x)(entmakex(list'(0 . "line")(cons 10(car x))(cons 11(cadr x))'(62 . 4)))))ls))
      ))
没有象黄老师那样搞自动参考线，需要自己通过两点确定参考方向，也没有计算所需要的参考线长度

紫苏炒黄瓜 发表于 2022-12-15 17:22:30

自动辅助线

统一网名 发表于 2023-7-20 09:27:26

确实不错，
页: 1 [2]
查看完整版本: 有人说，这个还不错