明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 34595|回复: 234

[源码] 简单的投影程序

  [复制链接]
发表于 2014-1-10 09:58 | 显示全部楼层 |阅读模式
本帖最后由 菜卷鱼 于 2015-12-11 08:46 编辑

多段线投影的程序论坛已经有了http://bbs.mjtd.com/forum.php?mod=viewthread&tid=107683
因为程序是很久以前写的,结构比较冗杂,没有花时间去重写。
2015年8月18号更新,目前支持直线、圆、圆弧、多段线,并加快了反应速度。
内容回复可见,不想回复的直接下载附件吧。

  1. (defun c:pp ( )
  2.   (princ "\n简单投影程序,制作BY菜卷鱼")
  3.   (setq pi2 (/ pi 2))
  4.   (setq 3pi2 (/ (* 3 pi) 2))
  5.   (setq  les (ssget '((0 . "LINE,CIRCLE,ARC")
  6.          (-4 . "<NOT")
  7.          (8 . "中心线")
  8.          (-4 . "NOT>")
  9.         )
  10.       )
  11.   )
  12.   (setq i 0)
  13.   (setq pltlr nil)
  14.   (setq pltud nil)
  15.   (setq clt nil)
  16.   (setq plt nil)
  17.   (repeat (sslength les)
  18.     (setq obj (ssname les i))
  19.     (setq info (entget obj))
  20.     (setq ac0 (cdr (assoc 0 info)))
  21.     (cond
  22.       ((= ac0 "CIRCLE")
  23.        (progn
  24.    (setq dr40 (cdr (assoc 40 info)))
  25.    (setq pt10 (cdr (assoc 10 info)))
  26.    (setq clt (cons pt10 clt))
  27.    (setq pltlr (cons (polar pt10 0 dr40)
  28.          (cons (polar pt10 pi dr40) pltlr)
  29.          )
  30.    )
  31.    (setq pltud (cons (polar pt10 pi2 dr40)
  32.          (cons (polar pt10 3pi2 dr40) pltud)
  33.          )
  34.    )
  35.        )
  36.       )
  37.       ((= ac0 "ARC")
  38.        (setq pt10 (cdr (assoc 10 info)))
  39.        (setq clt (cons pt10 clt))
  40.       )
  41.       ((= ac0 "LINE")
  42.        (setq pt10 (cdr (assoc 10 info)))
  43.        (setq pt11 (cdr (assoc 11 info)))
  44.        (setq plt (cons pt10 (cons pt11 plt)))
  45.       )
  46.     )
  47.   )
  48. (prin1)
  49. )

以下是完整源码
  1. (defun c:pps  (/ mm_lay pi2 2pi 3pi2 les i pltlr pltud clt plt
  2. obj info ac0 dr40 pt10 starc edarc pt11 pt10s p10
  3. n alist alist1 alist2 lft rht upt dnt cor1 cor2 cor3
  4. cor4 pcenter locat key xcor1 xcor2 xcor3 xcor4 plistn
  5. loc1 loc2 locat2 locn1 locn2 lcline0 clocat clocat2
  6. lcline1 lcline2 celine0 celine1 celine2 pt1 pt2
  7. oldline pt1 pt2 pt3 pt0 *error* erases mvs vxs)
  8. (defun erases (ss / i)    ;;;;等于(command "erase")
  9. (setq i -1)
  10. (repeat (sslength ss)
  11. (entdel (ssname ss (setq i (1+ i))))
  12. ))
  13. (defun mvs (lst / a lst2)  ;;;列表去重
  14.   (while (setq a (car lst) lst2 (cons a lst2) lst (vl-remove a lst)))
  15.   (reverse lst2)
  16. )
  17. (defun vxs (e / i v lst)   ;;;;获得多义线端点
  18.   (setq i -1)
  19.   (while
  20.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
  21.      (setq lst (cons v lst))
  22.   )
  23.   (reverse lst)
  24. )
  25. (defun *error*(s)  
  26. (setvar 'cmdecho 0)
  27. (command "_.ucs" "p")
  28. (command "_.undo" "e")
  29. (setvar 'cmdecho 1)
  30. (redraw)
  31. )
  32.   (princ "\n简单投影程序,制作BY菜卷鱼")
  33.   (setvar "cmdecho" 0)
  34.   (command "_.undo" "be")
  35.   (command "_.ucs" "")
  36.   (if (null (tblsearch "layer" "03中心线"))
  37.     (progn (setq mm_lay (getvar "CLAYER"))
  38.            (setvar "cmdecho" 0)
  39.            (command "_layer" "m"      "03中心线"        "c"
  40.                     "1"             ""              "l"      "center"        ""
  41.                     "lw"     "0.18"   "03中心线"        "")
  42.            (setvar "cmdecho" 1)
  43.            (setvar "clayer" mm_lay)))

  44.   (if (null (tblsearch "layer" "04虚线"))
  45.     (progn (setq mm_lay (getvar "CLAYER"))
  46.            (setvar "cmdecho" 0)
  47.            (command "_layer" "m"      "04虚线" "c"        "2"
  48.                     ""             "l"      "DASHED" ""        "lw"
  49.                     "0.18"   "04虚线" "")
  50.            (setvar "cmdecho" 1)
  51.            (setvar "clayer" mm_lay)))
  52.   (setq pi2 (/ pi 2))
  53.   (setq 2pi (* pi 2))
  54.   (setq 3pi2 (/ (* 3 pi) 2))
  55.   (setq        les (ssget '((0 . "LINE,CIRCLE,ARC,LWPOLYLINE")
  56.                      (-4 . "<NOT")
  57.                      (8 . "*03中心线*")
  58.                      (-4 . "NOT>")
  59.                      )
  60.                    )
  61.         )
  62.   (setq i 0)
  63.   (repeat (sslength les)
  64.     (setq obj (ssname les i))
  65.     (setq info (entget obj))
  66.     (setq ac0 (cdr (assoc 0 info)))
  67.     (cond
  68.       ((= ac0 "CIRCLE")
  69.        (progn
  70.          (setq dr40 (cdr (assoc 40 info)))
  71.          (setq pt10 (cdr (assoc 10 info)))
  72.          (setq clt (cons pt10 clt))
  73.          (setq pltlr (cons (polar pt10 0 dr40)
  74.                            (cons (polar pt10 pi dr40) pltlr)
  75.                            )
  76.                )
  77.          (setq pltud (cons (polar pt10 pi2 dr40)
  78.                            (cons (polar pt10 3pi2 dr40) pltud)
  79.                            )
  80.                )
  81.          )
  82.        )
  83. ;;;;;;;;;;;;;;;
  84.       ((= ac0 "ARC")
  85.        (setq dr40 (cdr (assoc 40 info)))
  86.        (setq pt10 (cdr (assoc 10 info)))
  87.        ;; (setq clt (cons pt10 clt))
  88.        (setq starc (cdr (assoc 50 info)))
  89.        (setq edarc (cdr (assoc 51 info)))
  90. ;;;;
  91.        (if
  92.          (or
  93.            (and (= starc 0) (= edarc pi))
  94.            (and (= starc pi) (= edarc 0))
  95.            (and (= starc pi2) (= edarc 3pi2))
  96.            (and (= starc 3pi2) (= edarc pi2))
  97.            )
  98.           (setq clt (cons pt10 clt))
  99.           )
  100.        (cond
  101.          ((or

  102.             (and (<= starc pi2) (<= pi2 edarc) (< edarc 3pi2))
  103.             (and (<= pi2 edarc) (< edarc 3pi2 starc))
  104.             )
  105.           (setq pltud (cons (polar pt10 pi2 dr40) pltud))
  106.           )
  107.          ;;上
  108.          ((or
  109.             (and (<= starc pi2) (>= edarc 3pi2))
  110.             (and (<= starc pi2) (< edarc pi2))
  111.             (and (> starc 3pi2) (>= edarc 3pi2))
  112.             )
  113.           (setq        pltud (cons (polar pt10 pi2 dr40)
  114.                             (cons (polar pt10 3pi2 dr40) pltud)
  115.                             )
  116.                 )
  117.           )
  118.          ;;LT上下
  119.          ((<= pi2 edarc starc 3pi2)
  120.           (setq        pltud (cons (polar pt10 pi2 dr40)
  121.                             (cons (polar pt10 3pi2 dr40) pltud)
  122.                             )
  123.                 )
  124.           )
  125.          ;;RG上下
  126.          ((and
  127.             (> starc pi2)
  128.             (<= starc 3pi2)
  129.             (or (>= edarc 3pi2) (and (>= edarc 0) (< edarc pi2))))
  130.           (setq pltud (cons (polar pt10 3pi2 dr40) pltud))
  131.           )
  132.          )
  133.        ;;下
  134. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  135.        (cond
  136.          ((and (<= starc pi edarc) (> starc 0))
  137.           (setq pltlr (cons (polar pt10 pi dr40) pltlr))
  138.           )
  139. ;;;左
  140.          ((<= pi edarc starc)
  141.           (setq        pltlr (cons (polar pt10 0 dr40)
  142.                             (cons (polar pt10 pi dr40) pltlr)
  143.                             )
  144.                 )
  145.           )
  146. ;;;UP左右
  147.          ((>= pi starc edarc)
  148.           (setq        pltlr (cons (polar pt10 0 dr40)
  149.                             (cons (polar pt10 pi dr40) pltlr)
  150.                             )
  151.                 )
  152.           )
  153. ;;;DN左右
  154.          ((< edarc pi starc)
  155.           (setq pltlr (cons (polar pt10 0 dr40) pltlr))
  156.           )
  157. ;;;右
  158.          )
  159.        )

  160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  161.       ((= ac0 "LINE")
  162.        (setq pt10 (cdr (assoc 10 info)))
  163.        (setq pt11 (cdr (assoc 11 info)))
  164.        (setq plt (cons pt10 (cons pt11 plt)))
  165.        )
  166. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  167.       ((= ac0 "LWPOLYLINE")
  168. (setq pt10s (vxs obj))
  169.         (setq plt (append pt10s plt))
  170.        )
  171. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  172.       )
  173.     (setq i (1+ i))
  174.     )
  175.   (setq alist (append plt pltlr pltud))
  176.   (setq
  177.     alist1
  178.      (vl-sort alist
  179.               (function (lambda (e1 e2) (< (car e1) (car e2))))
  180.               )
  181.     )
  182.   (setq lft (car alist1))
  183.   (setq rht (car (reverse alist1)))
  184.   (setq        alist2
  185.          (vl-sort alist
  186.                   (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
  187.                   )
  188.         )
  189.   (setq upt (car alist2))
  190.   (setq dnt (car (reverse alist2)))
  191. (setq alist1 (mvs alist1))
  192. (setq alist2 (mvs alist2))
  193.   (setq        cor1 (mapcar '+
  194.                      (mapcar '* lft '(1 0 1))
  195.                      (mapcar '* upt '(0 1 1))
  196.                      )
  197.         )
  198.   (setq        cor2 (mapcar '+
  199.                      (mapcar '* lft '(1 0 1))
  200.                      (mapcar '* dnt '(0 1 1))
  201.                      )
  202.         )
  203.   (setq        cor3 (mapcar '+
  204.                      (mapcar '* rht '(1 0 1))
  205.                      (mapcar '* upt '(0 1 1))
  206.                      )
  207.         )
  208.   (setq        cor4 (mapcar '+
  209.                      (mapcar '* rht '(1 0 1))
  210.                      (mapcar '* dnt '(0 1 1))
  211.                      )
  212.         )

  213.   (setq pcenter (inters cor1 cor4 cor3 cor2 nil))

  214.   (setq locat (getpoint pcenter "\n投影位置:"))

  215.   (if (> (abs (- (car locat) (car pcenter)))
  216.          (abs (- (cadr locat) (cadr pcenter)))
  217.          )
  218.     (setq key 0)
  219. ;;;x方向投影
  220.     (setq key 1)
  221. ;;;y方向投影
  222.     )

  223.   (cond
  224.     ((= key 0)
  225.      (setq
  226.        xcor1 (mapcar '+ cor1 '(99999 0 0))
  227.        xcor2 (mapcar '+ cor2 '(99999 0 0))
  228.        xcor3 (mapcar '+ cor3 '(-99999 0 0))
  229.        xcor4 (mapcar '+ cor4 '(-99999 0 0))
  230.        )
  231.      (grdraw xcor1 xcor3 1 1)
  232.      (grdraw xcor2 xcor4 1 1)
  233.      )
  234.     ((= key 1)
  235.      (setq
  236.        xcor1 (mapcar '+ cor1 '(0 99999 0))
  237.        xcor2 (mapcar '+ cor2 '(0 -99999 0))
  238.        xcor3 (mapcar '+ cor3 '(0 99999 0))
  239.        xcor4 (mapcar '+ cor4 '(0 -99999 0))
  240.        )
  241.      (grdraw xcor1 xcor2 1 1)
  242.      (grdraw xcor3 xcor4 1 1)
  243.      )
  244.     )

  245.   (cond
  246.     ((= key 0)
  247.      (setq plistn (append plt pltud))
  248.      (setq loc1        (mapcar        '+
  249.                         (mapcar '* locat '(1 0 1))
  250.                         (mapcar '* upt '(0 1 1))
  251.                         )
  252.            )
  253.      (setq loc2        (mapcar        '+
  254.                         (mapcar '* locat '(1 0 1))
  255.                         (mapcar '* dnt '(0 1 1))
  256.                         )
  257.            )
  258.      )
  259.     ((= key 1)
  260.      (setq plistn (append plt pltlr))
  261.      (setq loc1        (mapcar        '+
  262.                         (mapcar '* locat '(0 1 1))
  263.                         (mapcar '* lft '(1 0 1))
  264.                         )
  265.            )
  266.      (setq loc2        (mapcar        '+
  267.                         (mapcar '* locat '(0 1 1))
  268.                         (mapcar '* rht '(1 0 1))
  269.                         )
  270.            )
  271.      )
  272.     )
  273.   (grdraw loc1 loc1 1 1)

  274.   (setq locat2 (getpoint locat "\n投影宽度:"))
  275.   (cond
  276.     ((= key 0)
  277.      (setq locn1 (mapcar '+
  278.                          (mapcar '* locat2 '(1 0 1))
  279.                          (mapcar '* upt '(0 1 1))
  280.                          )
  281.            )
  282.      (setq locn2 (mapcar '+
  283.                          (mapcar '* locat2 '(1 0 1))
  284.                          (mapcar '* dnt '(0 1 1))
  285.                          )
  286.            )
  287.      (setq
  288.        lcline0 (mapcar '(lambda (x) (mapcar '* x '(0 1 1))) plistn))
  289.      (if (> (car locat) (car locat2))
  290.        (setq clocat  locat
  291.              clocat2 locat2
  292.              )
  293.        (setq clocat  locat2
  294.              clocat2 locat
  295.              )
  296.        )
  297.      (setq lcline1
  298.             (mapcar
  299.               '(lambda (x) (mapcar '+ x (mapcar '* locat '(1 0 1))))
  300.               lcline0
  301.               )
  302.            )
  303.      (setq lcline2
  304.             (mapcar
  305.               '(lambda (x) (mapcar '+ x (mapcar '* locat2 '(1 0 1))))
  306.               lcline0
  307.               )
  308.            )
  309.      (setq celine0 (mapcar '(lambda (x) (mapcar '* x '(0 1 1))) clt))
  310.      (setq celine1
  311.             (mapcar
  312.               '(lambda (x)
  313.                  (mapcar '+ x '(10 0 0) (mapcar '* clocat '(1 0 1)))
  314.                  )
  315.               celine0
  316.               )
  317.            )
  318.      (setq
  319.        celine2 (mapcar '(lambda        (x)
  320.                           (mapcar '+
  321.                                   x
  322.                                   '(-10 0 0)
  323.                                   (mapcar '* clocat2 '(1 0 1))
  324.                                   )
  325.                           )
  326.                        celine0
  327.                        )
  328.        )
  329.      )
  330.     ((= key 1)
  331.      (setq locn1 (mapcar '+
  332.                          (mapcar '* locat2 '(0 1 1))
  333.                          (mapcar '* lft '(1 0 1))
  334.                          )
  335.            )
  336.      (setq locn2 (mapcar '+
  337.                          (mapcar '* locat2 '(0 1 1))
  338.                          (mapcar '* rht '(1 0 1))
  339.                          )
  340.            )
  341.      (setq
  342.        lcline0 (mapcar '(lambda (x) (mapcar '* x '(1 0 1))) plistn))
  343.      (if (> (cadr locat) (cadr locat2))
  344.        (setq clocat  locat
  345.              clocat2 locat2
  346.              )
  347.        (setq clocat  locat2
  348.              clocat2 locat
  349.              )
  350.        )
  351.      (setq lcline1
  352.             (mapcar
  353.               '(lambda (x) (mapcar '+ x (mapcar '* locat '(0 1 1))))
  354.               lcline0
  355.               )
  356.            )
  357.      (setq lcline2
  358.             (mapcar
  359.               '(lambda (x) (mapcar '+ x (mapcar '* locat2 '(0 1 1))))
  360.               lcline0
  361.               )
  362.            )
  363.      (setq celine0 (mapcar '(lambda (x) (mapcar '* x '(1 0 1))) clt))
  364.      (setq celine1
  365.             (mapcar
  366.               '(lambda (x)
  367.                  (mapcar '+ x '(0 10 0) (mapcar '* clocat '(0 1 1)))
  368.                  )
  369.               celine0
  370.               )
  371.            )
  372.      (setq
  373.        celine2 (mapcar '(lambda        (x)
  374.                           (mapcar '+
  375.                                   x
  376.                                   '(0 -10 0)
  377.                                   (mapcar '* clocat2 '(0 1 1))
  378.                                   )
  379.                           )
  380.                        celine0
  381.                        )
  382.        )
  383.      )
  384.     )
  385.   (grdraw locn1 locn1 1 1)


  386.   (entmake (list '(0 . "line")
  387.                  '(8 . "0")
  388.                  (cons 10 loc1)
  389.                  (cons 11 loc2)
  390.                  )
  391.            )
  392.   (entmake (list '(0 . "line")
  393.                  '(8 . "0")
  394.                  (cons 10 locn1)
  395.                  (cons 11 locn2)
  396.                  )
  397.            )

  398.   (repeat
  399.     (length plistn)
  400.      (setq pt1 (car lcline1))
  401.      (setq lcline1 (cdr lcline1))
  402.      (setq pt2 (car lcline2))
  403.      (setq lcline2 (cdr lcline2))
  404.      (setq oldline (ssget "_w" pt1 pt2))

  405.      (if (and (/= oldline nil) (/= (sslength oldline) 0))
  406. (erases oldline)
  407.        )

  408.      (entmake (list '(0 . "line")
  409.                     '(8 . "04虚线")
  410.                     (cons 10 pt1)
  411.                     (cons 11 pt2)
  412.                     )
  413.               )
  414.      )

  415.   (repeat (length clt)
  416.     (setq pt1 (car celine1))
  417.     (setq celine1 (cdr celine1))
  418.     (setq pt2 (car celine2))
  419.     (setq celine2 (cdr celine2))
  420.     (setq oldline (ssget "_w" pt1 pt2))

  421.     (if        (and (/= oldline nil) (/= (sslength oldline) 0))
  422. (erases oldline)
  423.       )

  424.     (entmake (list '(0 . "line")
  425.                    '(8 . "03中心线")
  426.                    (cons 10 pt1)
  427.                    (cons 11 pt2)
  428.                    )
  429.              )
  430.     )
  431. (setq oldline (ssget "_w" loc1 locn1))

  432.   (if (and (/= oldline nil) (/= (sslength oldline) 0))
  433. (erases oldline)
  434.     )

  435.   (entmake (list '(0 . "line")
  436.                  '(8 . "0")
  437.                  (cons 10 loc1)
  438.                  (cons 11 locn1)
  439.                  )
  440.            )
  441.   (setq oldline (ssget "_w" loc2 locn2))

  442.   (if (and (/= oldline nil) (/= (sslength oldline) 0))
  443. (erases oldline)
  444.     )

  445.   (entmake (list '(0 . "line")
  446.                  '(8 . "0")
  447.                  (cons 10 loc2)
  448.                  (cons 11 locn2)
  449.                  )
  450.            )
  451.   (command "_.ucs" "p")
  452.   (command "_.undo" "e")
  453.   (setvar "cmdecho" 0)
  454.   (prin1)
  455.   )
  456.   (princ "\n简单投影程序,制作BY菜卷鱼")
  457. (prin1)

  458. (prin1)



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 5明经币 +4 金钱 +5 收起 理由
lee50310 + 1 赞一个!
1205这样时代 + 5 很给力!
crazylsp + 1 赞一个!比较实用
flyfox1047 + 1 原创,赞一个!
zctao1966 + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2020-2-25 12:17 | 显示全部楼层
本帖最后由 xj6019 于 2020-2-25 13:54 编辑

您好老师,程序试用了一下,不知道您贴出来的代码和现成的文件里面有没有区别,我两个都试了发现了点小问题,看看能解决么
我的附件里面这种形状用程序投影,相邻的两个线挨着太紧的话,就只能投影出一根线来,请问能解决吗
小点的图都没问题,一旦如图板很薄但是整个断面很宽的时候,投影就总出这个问题,你的两部分代码我都试过了,效果均相同. 会不定时一会好一会不行,都没有规律,相同的断面,运行代码时好时坏,代码的判断还不是固定的吗?搞不懂咋回事呢,好奇怪!
求解决方案,谢谢!!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2020-9-18 13:04 | 显示全部楼层
这要谁能写一个补全三视图就厉害了,经常碰到那样的三视图给了两视,要自己画第三个试图的。烦人得很!要是有3D我不自己用UG之类的出工程图就是
发表于 2019-10-31 11:34 | 显示全部楼层
感謝分享                     
发表于 2014-1-10 10:03 | 显示全部楼层
cad也可以画3d图啊
发表于 2014-1-10 10:40 | 显示全部楼层
cad三维太弱了

点评

CAD三维可是不弱,只是有些人没有把功夫练习到家罢了  发表于 2015-11-9 13:39
我公司和楼主一样,不让用三维。  发表于 2014-1-11 19:01
不是cad三维太弱,而是你制图太弱,真正制图人员不需要三维。  发表于 2014-1-11 18:59
相对专业三维软件是弱了点,可以借助INVENTOR FUSION 来完成,效率会高很多,现在新版本CAD安装时可选择同时安装FUSION  发表于 2014-1-10 13:10
发表于 2014-1-10 11:29 | 显示全部楼层
看看这个原理是什么。
发表于 2014-1-10 11:36 | 显示全部楼层
支持一下!
发表于 2014-1-10 11:36 | 显示全部楼层
先看完整的
发表于 2014-1-10 11:49 | 显示全部楼层
下载收藏了
发表于 2014-1-10 12:35 | 显示全部楼层
dear sir,
nice program
发表于 2014-1-10 12:43 | 显示全部楼层
CAD画三维也不错的,只是没有数据结构,三维投影三视可参考 zctao1966的转三视图程序
发表于 2014-1-10 12:46 | 显示全部楼层
CAD也可以画三维,画好之后也可以转三视图的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 21:26 , Processed in 0.335815 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表