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

alpha223334 发表于 2020-2-25 13:53:55

(defun c:zc (/       abc bbb acl ace ang a       q n       qxqy       ang1       i
         b       c sx       syex       eyps       per       r1r2       p1p2       p3
         cl       ccas       aes       a1a2       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线，图块，圆，椭圆这些

woxin168 发表于 2024-9-17 17:15:21

个人感觉，这个需求不是太大，需要轴测图了，拉个三位，轴测秒成，用二维图生成，且不说规则说不清楚，每条线谁剪谁很难写明白。

alpha223334 发表于 2020-2-27 10:08:18

自己再顶一个，@各位版主

Block 发表于 2020-9-4 16:32:31

顶了那么多次也没用啊;P

alpha223334 发表于 2020-2-28 08:17:44

再顶下，麻烦各位大神了

alpha223334 发表于 2020-3-3 10:36:45

我发的，再顶下

alpha223334 发表于 2020-3-6 09:02:34

帖子不要沉，再顶，寻高人！

alpha223334 发表于 2020-3-10 10:41:17

继续顶起

davide888 发表于 2020-6-1 18:25:26

很方便，帮你顶。

qq1254582201 发表于 2020-6-5 10:05:28

借鉴学习一下

林小林子 发表于 2020-9-4 15:54:13

学习

页: [1] 2

明经CAD社区's Archiver

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