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

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

(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线，图块，圆，椭圆这些

咏郡 · 发表于 2024-12-1 20:19:59

(defun c:zc (/ ang cecol chuli clay cmd dxf i n name osm pt ss)
(defun chuli(dxf pt / a1 a1x a1y a2 a2x a2y ae ang1 as cc cl d dx dxf10list dy ex ey i p p1 p2 p3 pe ps qx qy r r1 r2 s sx sy)
(setq
qx       (car pt)
qy       (cadr pt)
ang1 (* pi (/ ang 180.0))
)

(if (equal '(0 . "LINE") (assoc 0 dxf)) ;if-1
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
ex (- (cadr (assoc 11 dxf)) qx)
ey (- (caddr (assoc 11 dxf)) 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))
dxf  (subst ps (assoc 10 dxf) dxf)
dxf  (subst pe (assoc 11 dxf) dxf)

)
(entmod dxf)
)
)                               ;endif-1
(if (equal '(0 . "CIRCLE") (assoc 0 dxf)) ;if-2
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
r  (cdr (assoc 40 dxf))
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)

cl (cdr (assoc 8 dxf))
cc (cdr (assoc 62 dxf))
)
(setvar "clayer" cl)
(if       cc
(command "setvar" "cecolor" cc)
(setvar "cecolor" "BYLAYER")
)
(command "_ellipse" p1 p2 p3)
(entdel name)
)
)                               ;endif-2
(if (equal '(0 . "ARC") (assoc 0 dxf)) ;if-3
(progn
(setq
sx  (- (cadr (assoc 10 dxf)) qx)
sy  (- (caddr (assoc 10 dxf)) qy)
as  (cdr (assoc 50 dxf))
ae  (cdr (assoc 51 dxf))
r (cdr (assoc 40 dxf))
s (list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
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)

as  (angtos (- (angle p a1) (/ ang1 2)) 0 4)
ae  (angtos (- (angle p a2) (/ ang1 2)) 0 4)
cl  (cdr (assoc 8 dxf))
cc  (cdr (assoc 62 dxf))
)
(setvar "clayer" cl)
(if       cc
(command "setvar" "cecolor" cc)
(setvar "cecolor" "BYLAYER")
)
(command "_ellipse" "a" p1 p2 p3 as ae)
(entdel name)
)
)                               ;endif-3
(if (equal '(0 . "TEXT") (assoc 0 dxf)) ;if-4
(progn
(if       (= (cdr (assoc 72 dxf)) 5)
(setq ex (cadr (assoc 11 dxf))
ey (caddr (assoc 11 dxf))
)
(setq ex (car (polar
(list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
(cdr (assoc 50 dxf))
1000
)
   )
ey (cadr
   (polar
   (list (cadr (assoc 10 dxf)) (caddr (assoc 10 dxf)))
   (cdr (assoc 50 dxf))
   1000
   )
   )
)
)
(setq
sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) 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 dxf)) qx)
dy (- (caddr (assoc 11 dxf)) qy)
dx (+ (+ dx (* dy (cos ang1))) qx)
dy (+ (* dy (sin ang1)) qy)
as (angle (list sx sy) (list ex ey))
dxf  (subst (cons 10 (list sx sy 0)) (assoc 10 dxf) dxf)
dxf  (subst (cons 11 (list dx dy 0)) (assoc 11 dxf) dxf)
dxf  (subst (cons 50 as) (assoc 50 dxf) dxf)
)
(entmod dxf)
)
)                               ;endif-4
(if (equal '(0 . "LWPOLYLINE") (assoc 0 dxf)) ;if-5
(progn
(setq
dxf10list(vl-remove-if-not ;提取选择集能通过测试的表
'(lambda (x) (eq 10 (car x)));测试函数
dxf)
)
(foreach n dxf10list
(setq
sx (- (cadr n) qx)
sy (- (caddr n) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ps (cons 10 (list sx sy 0))
dxf  (subst ps n dxf)
)
)
(entmod dxf)
)
) ;endif-5
(if (equal '(0 . "INSERT") (assoc 0 dxf)) ;if-6
(progn
(setq sx (- (cadr (assoc 10 dxf)) qx)
sy (- (caddr (assoc 10 dxf)) qy)
sx (+ (+ sx (* sy (cos ang1))) qx)
sy (+ (* sy (sin ang1)) qy)
ps (cons 10 (list sx sy 0))
dxf  (subst ps (assoc 10 dxf) dxf)
)
(entmod dxf)
)
)
)
;====================
(command "UNDO""be")
  (setq
cmd (getvar "cmdecho")
osm (getvar "osmode")
clay (getvar "clayer")
cecol (getvar "cecolor")
  )

  (graphscr)
  (setq ang (getreal (strcat "\n输入轴侧<45>(度):")))
  (if (= ang nil)
(setq ang 45.0
)
  )
  (princ "\n选择图素:")
  (setq       ss (ssget '(
(0 . "line,circle,arc,text,LWPOLYLINE,INSERT")

)
)
pt (getpoint (strcat "\n输入标准点:"))
  )
(setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "PELLIPSE" 0)
  (if ss                                     ;if
(progn
   (setq n(sslength ss)
i 0
   )
   (while (< i n)                      ;while-2
      (setq name  (ssname ss i)
dxf       (entget name)

      )

(chuli dxf pt)
(setq i (1+ i))
)                                     ;while-2
)
(princ "/n选择错误!")
  )                                     ;endif
  (setvar "cmdecho" cmd)
  (setvar "osmode" osm)
  (setvar "clayer" clay)
  (setvar "cecolor" cecol)
(command "UNDO""e")
  (princ)
);添加了多段线，但块还是不行

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

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

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

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

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

学习

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

顶了那么多次也没用啊

账号		自动登录	找回密码
密码			注册

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

评分