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

chenry676

我为何运行不了？

woxin168

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

咏郡

(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)
);添加了多段线，但块还是不行