明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 774|回复: 9

[源码] 求大神帮忙修改下平面图转轴测图源码

[复制链接]
发表于 2020-2-25 13:53 | 显示全部楼层 |阅读模式
(defun c:zc (/         abc bbb acl ace ang a         q   n         qx  qy         ang1         i
             b         c   sx         sy  ex         ey  ps         pe  r         r1  r2         p1  p2         p3
             cl         cc  as         ae  s         a1  a2         a1x a1y a2x a2y
            )
  (setq        abc (getvar "cmdecho")
        bbb (getvar "osmode")
        acl (getvar "clayer")
        ace (getvar "cecolor")
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "PELLIPSE" 0)
  (graphscr)
  (setq ang (getreal (strcat "\n输入轴侧<45>(度):")))
  (if (= ang nil)
    (setq ang 45.0
    )
  )
  (princ "\n选择图素:")
  (setq        a (ssget '((-4 . "<OR")
                   (0 . "line")
                   (0 . "circle")
                   (0 . "arc")
                   (0 . "text")
                   (-4 . "OR>")
                  )
          )
        q (getpoint (strcat "\n输入标准点:"))
  )
  (if a                                        ;if
    (progn
      (setq n         (sslength a)
            qx         (car q)
            qy         (cadr q)
            ang1 (* pi (/ ang 180))
            i         0
      )
      (while (< i n)                        ;while-2
        (setq b        (ssname a i)
              c        (entget b)
        )
        (if (equal '(0 . "LINE") (assoc 0 c)) ;if-1
          (progn
            (setq sx (- (cadr (assoc 10 c)) qx)
                  sy (- (caddr (assoc 10 c)) qy)
                  ex (- (cadr (assoc 11 c)) qx)
                  ey (- (caddr (assoc 11 c)) qy)
                  sx (+ (+ sx (* sy (cos ang1))) qx)
                  sy (+ (* sy (sin ang1)) qy)
                  ex (+ (+ ex (* ey (cos ang1))) qx)
                  ey (+ (* ey (sin ang1)) qy)
                  ps (cons 10 (list sx sy 0))
                  pe (cons 11 (list ex ey 0))
                  c  (subst ps (assoc 10 c) c)
                  c  (subst pe (assoc 11 c) c)
                  i  (+ i 1)
            )
            (entmod c)
          )
        )                                ;endif-1
        (if (equal '(0 . "CIRCLE") (assoc 0 c)) ;if-2
          (progn
            (setq sx (- (cadr (assoc 10 c)) qx)
                  sy (- (caddr (assoc 10 c)) qy)
                  r  (cdr (assoc 40 c))
                  sx (+ (+ sx (* sy (cos ang1))) qx)
                  sy (+ (* sy (sin ang1)) qy)
                  r1 (* (sqrt (+ 1 (cos ang1))) r)
                  r2 (* (sqrt (- 1 (cos ang1))) r)
                  p  (list sx sy)
                  p1 (polar p (/ ang1 2) r1)
                  p2 (polar p (/ ang1 2) (- 0.0 r1))
                  p3 (polar p (/ (+ ang1 pi) 2) r2)
                  i  (+ i 1)
                  cl (cdr (assoc 8 c))
                  cc (cdr (assoc 62 c))
            )
            (setvar "clayer" cl)
            (if        cc
              (command "setvar" "cecolor" cc)
              (setvar "cecolor" "BYLAYER")
            )
            (command "_ellipse" p1 p2 p3)
            (entdel b)
          )
        )                                ;endif-2
        (if (equal '(0 . "ARC") (assoc 0 c)) ;if-3
          (progn
            (setq sx  (- (cadr (assoc 10 c)) qx)
                  sy  (- (caddr (assoc 10 c)) qy)
                  as  (cdr (assoc 50 c))
                  ae  (cdr (assoc 51 c))
                  r   (cdr (assoc 40 c))
                  s   (list (cadr (assoc 10 c)) (caddr (assoc 10 c)))
                  a1  (polar s as r)
                  a2  (polar s ae r)
                  a1x (- (car a1) qx)
                  a1y (- (cadr a1) qy)
                  a2x (- (car a2) qx)
                  a2y (- (cadr a2) qy)
                  a1x (+ (+ a1x (* a1y (cos ang1))) qx)
                  a1y (+ (* a1y (sin ang1)) qy)
                  a2x (+ (+ a2x (* a2y (cos ang1))) qx)
                  a2y (+ (* a2y (sin ang1)) qy)
                  a1  (list a1x a1y)
                  a2  (list a2x a2y)
                  sx  (+ (+ sx (* sy (cos ang1))) qx)
                  sy  (+ (* sy (sin ang1)) qy)
                  r1  (* (sqrt (+ 1 (cos ang1))) r)
                  r2  (* (sqrt (- 1 (cos ang1))) r)
                  p   (list sx sy)
                  p1  (polar p (/ ang1 2) r1)
                  p2  (polar p (/ ang1 2) (- 0.0 r1))
                  p3  (polar p (/ (+ ang1 pi) 2) r2)
                  i   (+ i 1)
                  as  (angtos (- (angle p a1) (/ ang1 2)) 0 4)
                  ae  (angtos (- (angle p a2) (/ ang1 2)) 0 4)
                  cl  (cdr (assoc 8 c))
                  cc  (cdr (assoc 62 c))
            )
            (setvar "clayer" cl)
            (if        cc
              (command "setvar" "cecolor" cc)
              (setvar "cecolor" "BYLAYER")
            )
            (command "_ellipse" "a" p1 p2 p3 as ae)
            (entdel b)
          )
        )                                ;endif-3
        (if (equal '(0 . "TEXT") (assoc 0 c)) ;if-4
          (progn
            (if        (= (cdr (assoc 72 c)) 5) ;if-5
              (setq ex (cadr (assoc 11 c))
                    ey (caddr (assoc 11 c))
              )

              (setq ex (car (polar
                              (list (cadr (assoc 10 c)) (caddr (assoc 10 c)))
                              (cdr (assoc 50 c))
                              1000
                            )
                       )
                    ey (cadr
                         (polar
                           (list (cadr (assoc 10 c)) (caddr (assoc 10 c)))
                           (cdr (assoc 50 c))
                           1000
                         )
                       )
              )
            )                                ;endif-5
            (setq sx (- (cadr (assoc 10 c)) qx)
                  sy (- (caddr (assoc 10 c)) qy)
                  sx (+ (+ sx (* sy (cos ang1))) qx)
                  sy (+ (* sy (sin ang1)) qy)
                  ex (- ex qx)
                  ey (- ey qy)
                  ex (+ (+ ex (* ey (cos ang1))) qx)
                  ey (+ (* ey (sin ang1)) qy)
                  dx (- (cadr (assoc 11 c)) qx)
                  dy (- (caddr (assoc 11 c)) qy)
                  dx (+ (+ dx (* dy (cos ang1))) qx)
                  dy (+ (* dy (sin ang1)) qy)
                  as (angle (list sx sy) (list ex ey))
                  d  '((0 . "TEXT")
                       (100 . "AcDbEntity")
                       (67 . 0)
                       (410 . "Model")
                       (8 . "0")
                       (100 . "AcDbText")
                       (10 115.157 111.17 0.0)
                       (40 . 2.5)
                       (1 . "35456465")
                       (50 . 0.0)
                       (41 . 0.6)
                       (51 . 0.0)
                       (7 . "Standard")
                       (71 . 0)
                       (72 . 0)
                       (11 0.0 0.0 0.0)
                       (210 0.0 0.0 1.0)
                       (100 . "AcDbText")
                       (73 . 0)
                      )
                  d  (subst (assoc 1 c) (assoc 1 d) d)
                  d  (subst (assoc 7 c) (assoc 7 d) d)
                  d  (subst (assoc 8 c) (assoc 8 d) d)
                  d  (subst (cons 10 (list sx sy 0)) (assoc 10 d) d)
                  d  (subst (cons 11 (list dx dy 0)) (assoc 11 d) d)
                  d  (subst (assoc 40 c) (assoc 40 d) d)
                  d  (subst (cons 50 as) (assoc 50 d) d)
                  d  (subst (assoc 67 c) (assoc 67 d) d)
                  d  (subst (assoc 73 c) (assoc 73 d) d)
                  i  (+ i 1)
            )
            (if        (/= (cdr (assoc 72 c)) 5)
              (setq d (subst (assoc 72 c) (assoc 72 d) d)
              )
            )
            (entmake d)
            (entdel b)
          )
        )                                ;endif-4
      )                                        ;while-2
    )
    (princ "/n选择错误!")
  )                                        ;endif
  (setvar "cmdecho" abc)
  (setvar "osmode" bbb)
  (setvar "clayer" acl)
  (setvar "cecolor" ace)
  (princ)
)
上面是源码,求大神们帮忙修改下,使它能用于pl线,图块,圆,椭圆这些

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 赞一个!

查看全部评分

 楼主| 发表于 2020-2-27 10:08 | 显示全部楼层
自己再顶一个,@各位版主
 楼主| 发表于 2020-2-28 08:17 | 显示全部楼层
再顶下,麻烦各位大神了
 楼主| 发表于 2020-3-3 10:36 | 显示全部楼层
我发的,再顶下
 楼主| 发表于 2020-3-6 09:02 | 显示全部楼层
帖子不要沉,再顶,寻高人!
发表于 2020-6-1 18:25 | 显示全部楼层
很方便,帮你顶。
发表于 2020-6-5 10:05 | 显示全部楼层
借鉴学习一下
发表于 2020-9-4 16:32 | 显示全部楼层
顶了那么多次也没用啊
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-6 20:02 , Processed in 1.666372 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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