xiehaoing 发表于 2022-2-16 10:02:38

求一个画弧形投影线的工具

求一个画弧形投影线的工具
类似这样的
选中平面的弧形，然后可以自动实现立面正投影，并添加这种投影线，最好能给个源码。谢谢了

xyp1964 发表于 2022-2-16 10:02:39


(defun c:tt ()
(defun SSelEntnext (en / ss)
    (setq ss (ssadd))
    (while (setq en (entnext en)) (ssadd en ss))
    ss
)
(setq nn (getint "\n等分数量: "))
(or nn (setq nn 21))
(setq s1 (car (entsel "\n选择曲线: ")))
(setvar "osmode" 0)
(setq s0 (entlast))
(command "divide" s1 nn)
(setq        ss(SSelEntnext s0)
        p1(vlax-curve-getEndPoint s1)
        i   -1
        ptn '()
)
(while (setq s1 (ssname ss (setq i (1+ i))))
    (setq ptn (cons (cdr (assoc 10 (entget s1))) ptn))
)
(command "erase" ss "")
(setq        ptn(mapcar '(lambda (x) (list (car x) (cadr p1))) ptn)
        ptn1 (mapcar '(lambda (x) (list (car x) (- (cadr x) 1000))) ptn)
)
(mapcar '(lambda (x y) (command "line" x y "")) ptn ptn1)
(command "line" (car ptn) (last ptn) "")
(command "line" (car ptn1) (last ptn1) "")
(princ)
)

夏生生 发表于 2022-2-16 11:01:01

需求不是很详细，粗略写了一个，您可以试试
(defun c:test1 (/ dis en lst n pause pt1 pt2 pt3 pt4 ss)
(defun G-pertoline (pt pt1 pt2 / norm)
    (setq norm (mapcar '- pt2 pt1)
          pt1(trans pt1 0 norm)
          pt   (trans pt 0 norm)
          )
    (trans (list (car pt1) (cadr pt1) (caddr pt)) norm 0)
    )
(setq        en(vlax-ename->vla-object (car (entsel "\n选:")))
        n   (getint "\n等分数")
        ss(ssadd)
        dis (/ (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
             n
             )
        )
(repeat (1+ n)
    (setq
      lst (cons (vlax-curve-getpointatdist en (* n dis)) lst)
      n          (1- n)
      )
    )
(vla-getboundingbox en 'pt1 'pt2)
(setq        pt1 (vlax-safearray->list pt1)
        pt2 (vlax-safearray->list pt2)
        pt3 (list (car pt2) (cadr pt1))
        pt4 (list (car pt1) (cadr pt2))
        )
(setq        ss (ssadd (entmakex (list '(0 . "line")
                                  (cons 10 pt1)
                                  (cons 11 pt3)
                                  )
                          )
                  ss
                  )
        ss (ssadd (entmakex (list '(0 . "line")
                                  (cons 10 pt4)
                                  (cons 11 pt2)
                                  )
                          )
                  ss
                  )
        )
(foreach n lst
    (setq ss (ssadd (entmakex (list '(0 . "line")
                                  (cons 10 (G-pertoline n pt1 pt3))
                                  (cons 11 (G-pertoline n pt2 pt4))
                                  )
                              )
                  ss
                  )
          )
    )
(command "move" ss "" pt4 pt1)
)

xiehaoing 发表于 2022-2-16 15:43:37

夏生生 发表于 2022-2-16 11:01
需求不是很详细，粗略写了一个，您可以试试

你好 报错命令: ; 错误: 输入的字符串有缺陷   。。不知道什么原因

xj6019 发表于 2022-2-16 16:31:28

我测试的时候没出现呢   但是效果好像有点不太一样 那种渐变的感觉没有不过渐变好像挺费劲

cq4920 发表于 2022-2-16 17:41:25

本帖最后由 cq4920 于 2022-2-16 18:06 编辑


你那个透视关系不太对哟;P

最开始想到的是批量线上加点 然后由点画线！但是用的比较少，也就用了个笨方法
1.圆弧转多段线
2.QDIM 标注
3.炸开标注 删除多余部分.





xiehaoing 发表于 2022-2-17 10:34:43

cq4920 发表于 2022-2-16 17:41
你那个透视关系不太对哟

最开始想到的是批量线上加点 然后由点画线！但是用的比较少，也就用了个笨 ...

谢谢 ，就是这个意思

czb203 发表于 2022-2-17 20:27:12

他牛逼了，非常感谢

夏生生 发表于 2022-2-17 21:14:57

xiehaoing 发表于 2022-2-16 15:43
你好 报错命令: ; 错误: 输入的字符串有缺陷   。。不知道什么原因

代码没拷贝全吧

夏生生 发表于 2022-2-17 21:19:07

xj6019 发表于 2022-2-16 16:31
我测试的时候没出现呢   但是效果好像有点不太一样 那种渐变的感觉没有不过渐变好像挺费劲

按他那种渐变确实费劲，要算斜率
页: [1] 2
查看完整版本: 求一个画弧形投影线的工具