[原创]：平面图转45度轴测图源程序

nuance

全部用纯lisp，没有vlisp，因为不会。
cad2004,2005测试通过，其它版本未测试。
未考虑z坐标及ucs
arc(pl-arc),circle由pl逼近，以实际打印长度0.2mm为控制长度，
如果弧线很长，运行速度会很慢。
可转换实体：LINE,ARC,CIRCLE,LWPOLYLINE,TEXT,INSERT,RAY,XLINE,SOLID
其中pl可为不定宽度arc及line。
属性块中属性与块作为一个整体。
提供源码，请高手指点。

[php]

;transform plan to sys
;entities can be transformed: LINE,ARC,CIRCLE,LWPOLYLINE,TEXT,INSERT,RAY,XLINE,SOLID
(defun c:pts(/ plotscale ss y-base i ssn dxfdata r len m elist n b d
               pt-start x-start y-start x-end y-end ang-start ang-end ang
               pt1 pt2 width-fixed width-start width-end width-step headerlist
               n-vertext n-vertex-end ifclose layer color linetype ltscale lineweight
               pt-start-pl pt-dummy x-end-dummy y-end-dummy oldosmode oldautosnap)
   (command "undo" "begin")
   (setq plotscale (getreal "\ninput plot scale 1:<100>:"))
   (if (not plotscale)(setq plotscale 100.0))
   (setq ss (ssget ":L"))
   (initget 1)
   (setq y-base (cadr (getpoint "\nbase point:")))

   (setq i 0)
   (repeat (sslength ss);repeat0
      (setq ssn (ssname ss i))
      (setq dxfdata (entget ssn))

      (if (= "LINE" (cdr (assoc 0 dxfdata)));if1
         (progn;1
               (setq pt-start (cdr (assoc 10 dxfdata)))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
               (setq dxfdata (subst (list 10 x-end y-end) (assoc 10 dxfdata) dxfdata))

               (setq pt-start (cdr (assoc 11 dxfdata)))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
               (setq dxfdata (subst (list 11 x-end y-end) (assoc 11 dxfdata) dxfdata))
            (entmod dxfdata)
         );progn1
      );if1
      
      (if (= "ARC" (cdr (assoc 0 dxfdata)));if1
         (progn;1
            (setq layer (cdr (assoc 8 dxfdata)))
            (setq color (cdr (assoc 62 dxfdata)))
            (setq linetype (cdr (assoc 6 dxfdata)))
            (setq ltscale (cdr (assoc 48 dxfdata)))
            (setq lineweight (cdr (assoc 370 dxfdata)))
            
            (setq r (cdr (assoc 40 dxfdata)))
            (setq ang-start (cdr (assoc 50 dxfdata)))
            (setq ang-end   (cdr (assoc 51 dxfdata)))
            (setq len (* r (abs (- ang-end ang-start))))
            (setq m 24.0)
            (while (> (/ len m plotscale) 0.2);while1--plot length of every vertice <= 0.2mm
               (setq m (+ m 12.0))               
            );while1
            
            (setq elist (list (cons 0 "LWPOLYLINE")
                              (cons 100 "AcDbEntity")
                              (cons 100 "AcDbPolyline")         
                              (cons 43 0.0)
                              (cons 90 (fix m))
                              (cons 70 0)

                              (cons 8 layer)
                        )
            );setq

            (if color (setq elist (append elist (list (cons 62 color)))))
            (if linetype (setq elist (append elist (list (cons 6 linetype)))))
            (if ltscale (setq elist (append elist (list (cons 48 ltscale)))))
            (if lineweight (setq elist (append elist (list (cons 370 lineweight)))))

            (setq n 0)
            (repeat (+ (fix m) 1) ;repeat2
               (setq ang (- ang-end ang-start))
               (if (< ang 0.0)(setq ang (+ ang (* 2.0 pi))))
               (setq pt-start (polar (cdr (assoc 10 dxfdata)) (+ ang-start (/ (* (abs ang) n) m)) r))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))

               (setq elist (append elist (list (list 10 x-end y-end))))
               (setq n (+ n 1))
               
            );repeat2
            (entmake elist)
            (entdel ssn)
         );progn1
      );if1


      (if (= "CIRCLE" (cdr (assoc 0 dxfdata)));if1
         (progn;1
            (setq layer (cdr (assoc 8 dxfdata)))
            (setq color (cdr (assoc 62 dxfdata)))
            (setq linetype (cdr (assoc 6 dxfdata)))
            (setq ltscale (cdr (assoc 48 dxfdata)))
            (setq lineweight (cdr (assoc 370 dxfdata)))
            
            (setq r (cdr (assoc 40 dxfdata)))
            (setq len (* 2.0 pi r))
            (setq m 24.0)
            (while (> (/ len m plotscale) 0.2);while1--plot length of every vertice <= 0.2mm
               (setq m (+ m 24.0))               
            );while1
            
            (setq elist (list (cons 0 "LWPOLYLINE")
                              (cons 100 "AcDbEntity")
                              (cons 100 "AcDbPolyline")         
                              (cons 43 0.0)
                              (cons 90 (fix m))
                              (cons 70 1)

                              (cons 8 layer)                       
                         )
            );setq

            (if color (setq elist (append elist (list (cons 62 color)))))
            (if linetype (setq elist (append elist (list (cons 6 linetype)))))
            (if ltscale (setq elist (append elist (list (cons 48 ltscale)))))
            (if lineweight (setq elist (append elist (list (cons 370 lineweight)))))
            
            (setq n 0)
            (repeat (fix m) ;repeat2
               (setq pt-start (polar (cdr (assoc 10 dxfdata)) (/ (* pi 2.0 n) m) r))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))

               (setq elist (append elist (list (list 10 x-end y-end))))
               (setq n (+ n 1))
               
            );repeat2
            (entmake elist)
            (entdel ssn)
         );progn1
      );if1

      (if (= "LWPOLYLINE" (cdr (assoc 0 dxfdata)));if1
         (progn;1
            (setq layer (cdr (assoc 8 dxfdata)))
            (setq color (cdr (assoc 62 dxfdata)))
            (setq linetype (cdr (assoc 6 dxfdata)))
            (setq ltscale (cdr (assoc 48 dxfdata)))
            (setq lineweight (cdr (assoc 370 dxfdata)))
            
            (setq n-vertex (cdr (assoc 90 dxfdata)))
            (setq ifclose (cdr (assoc 70 dxfdata)))
            (setq width-fixed (cdr (assoc 43 dxfdata)))
            (setq n-vertex-end n-vertex)
            (setq elist '())
            (setq pt1 (cdr (assoc 10 dxfdata)))
            (setq pt-start-pl pt1)
            
            (setq dxfdata (cdr (member (assoc 10 dxfdata) dxfdata)))
            (setq x-start (car pt1) y-start (cadr pt1))
            (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
            (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
            (setq elist (append elist (list (list 10 x-end y-end))))

            (repeat (- n-vertex 1);1
               (if (and (= (cdr (assoc 42 dxfdata)) 0)(/= (assoc 10 dxfdata) nil));if2
                  (progn;2
                     (setq elist (append elist (list (assoc 40 dxfdata))))
                     (setq elist (append elist (list (assoc 41 dxfdata))))
                     (setq pt1 (cdr (assoc 10 dxfdata)))
             
                     (setq dxfdata (cdr (member (assoc 10 dxfdata) dxfdata)))
                     (setq x-start (car pt1) y-start (cadr pt1))
                     (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
                     (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
                     (setq elist (append elist (list (list 10 x-end y-end))))
                     
                  );progn2
               );if2

               (if (and (/= (cdr (assoc 42 dxfdata)) 0)(/= (assoc 10 dxfdata) nil));if3
                  (progn;3
                     (setq width-start (cdr (assoc 40 dxfdata)))
                     (setq width-end   (cdr (assoc 41 dxfdata)))
                     (setq pt2 (cdr (assoc 10 dxfdata)))

                     (setq b (abs (cdr (assoc 42 dxfdata))))
                     (setq d (distance pt1 pt2))
                     (setq r (abs (/ (* d (+ 1.0 (* b b)))(* 4.0 b))))
                    
                     (if (> (cdr (assoc 42 dxfdata)) 0.0)
                        (progn
                           (setq ang1 (- (- (angle pt1 pt2) (* 2.0 (atan b))) (/ pi 2.0)))
                           (setq ang2 (+ ang1 (* 4.0 (atan b))))
                           (setq pt-cen (polar pt1 (- ang1 pi) r))
                           (setq ang (- ang2 ang1))
                           (if (< ang 0.0)(setq ang (+ (* pi 2.0) ang)))
                        )
                      )

                      (if (< (cdr (assoc 42 dxfdata)) 0.0)
                         (progn
                            (setq ang2 (- (- (angle pt2 pt1) (* 2.0 (atan b))) (/ pi 2.0)))
                            (setq ang1 (+ ang2 (* 4.0 (atan b))))
                            (setq pt-cen (polar pt2 (- ang2 pi) r))
                            (setq ang (- ang2 ang1))
                            (if (> ang 0.0)(setq ang (- ang (* pi 2.0))))
                         )
                      )                    

                      (setq pt1 pt2)
                      (setq len (* r (abs ang)))
                      (setq m 24.0)
                      (while (> (/ len m plotscale) 0.2);while1--plot length of every vertice <= 0.2mm
                         (setq m (+ m 12.0))               
                      );while1
                     
                      (setq n-vertex-end (+ (fix m)  n-vertex-end))                      
                      (setq width-step (/ (- width-end width-start) m))

                      (setq n 0)
                      (repeat (fix m);2
                         (setq elist (append elist (list (cons 40 (+ width-start (* n width-step))))))
                         (setq elist (append elist (list (cons 41 (+ width-start (* (+ 1 n) width-step))))))
                         (setq pt-start (polar pt-cen (+ ang1 (/ (* ang (+ 1 n)) m)) r))
                         (setq x-start (car pt-start) y-start (cadr pt-start))
                         (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
                         (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))

                         (setq elist (append elist (list (list 10 x-end y-end))))
                         (setq n (+ n 1))
                      );repeat2
                      (setq dxfdata (cdr (member (assoc 10 dxfdata) dxfdata)))             
                  );progn3
               );if3
            );repeat1

            (if (= (cdr (assoc 42 dxfdata)) 0.0)
               (progn
                  (setq elist (append elist (list (assoc 40 dxfdata))))
                  (setq elist (append elist (list (assoc 41 dxfdata))))

                  (setq n-vertex (- n-vertex 1))
               )
            )

            (if (and (/= (cdr (assoc 42 dxfdata)) 0.0) (= ifclose 1));if4
                  (progn;4
                     (setq width-start (cdr (assoc 40 dxfdata)))
                     (setq width-end   (cdr (assoc 41 dxfdata)))
                     (setq pt2 pt-start-pl)

                     (setq b (abs (cdr (assoc 42 dxfdata))))
                     (setq d (distance pt1 pt2))
                     (setq r (abs (/ (* d (+ 1.0 (* b b)))(* 4.0 b))))
                    
                     (if (> (cdr (assoc 42 dxfdata)) 0.0)
                        (progn
                           (setq ang1 (- (- (angle pt1 pt2) (* 2.0 (atan b))) (/ pi 2.0)))
                           (setq ang2 (+ ang1 (* 4.0 (atan b))))
                           (setq pt-cen (polar pt1 (- ang1 pi) r))
                           (setq ang (- ang2 ang1))
                           (if (< ang 0.0)(setq ang (+ (* pi 2.0) ang)))
                        )
                      )

                      (if (< (cdr (assoc 42 dxfdata)) 0.0)
                         (progn
                            (setq ang2 (- (- (angle pt2 pt1) (* 2.0 (atan b))) (/ pi 2.0)))
                            (setq ang1 (+ ang2 (* 4.0 (atan b))))
                            (setq pt-cen (polar pt2 (- ang2 pi) r))
                            (setq ang (- ang2 ang1))
                            (if (> ang 0.0)(setq ang (- ang (* pi 2.0))))
                         )
                      )                    

                      (setq len (* r (abs ang)))
                      (setq m 24.0)
                      (while (> (/ len m plotscale) 0.2);while1--plot length of every vertice <= 0.2mm
                         (setq m (+ m 12.0))               
                      );while1
                     
                      (setq n-vertex-end (+ (fix m) n-vertex-end))

                      (setq n-vertex (- n-vertex 1))                     
                      (setq width-step (/ (- width-end width-start) m))

                      (setq n 0)
                      (repeat (fix m);2
                         (setq elist (append elist (list (cons 40 (+ width-start (* n width-step))))))
                         (setq elist (append elist (list (cons 41 (+ width-start (* (+ 1 n) width-step))))))
                         (setq pt-start (polar pt-cen (+ ang1 (/ (* ang (+ 1 n)) m)) r))
                         (setq x-start (car pt-start) y-start (cadr pt-start))
                         (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
                         (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))

                         (setq elist (append elist (list (list 10 x-end y-end))))
                         (setq n (+ n 1))
                      );repeat2
                   );progn4
               );if4

            (setq headerlist (list (cons 0 "LWPOLYLINE")
                                      (cons 100 "AcDbEntity")
                                   (cons 100 "AcDbPolyline")         
                                   (cons 90 n-vertex-end)
                                   (cons 70 ifclose)

                                   (cons 8 layer)
                             )
            );setq

            (if width-fixed (setq headerlist (append headerlist (list (cons 43 width-fixed)))))
            
            (if color    (setq headerlist (append headerlist (list (cons 62 color)))))
            (if linetype (setq headerlist (append headerlist (list (cons 6 linetype)))))
            (if ltscale  (setq headerlist (append headerlist (list (cons 48 ltscale)))))
            (if lineweight (setq headerlist (append headerlist (list (cons 370 lineweight)))))
            
            (setq elist (append headerlist elist))               
            (entmake elist)
            (entdel ssn)
         );progn1
      );if1

      (if (or(=  "TEXT" (cdr (assoc 0 dxfdata)))(=  "INSERT" (cdr (assoc 0 dxfdata))));if1
         (progn;1
               (setvar "cmdecho" 0)
               (setq oldosmode (getvar "osmode"))
               (setvar "osmode" 0)
               (setq oldautosnap (getvar "autosnap"))
               (setvar "autosnap" 0)
               (setq pt-start (cdr (assoc 10 dxfdata)))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
               
               (setq ang1 (cdr (assoc 50 dxfdata)))
               (setq pt-dummy (polar pt-start ang1 1.0))               
            
               (setq x-dummy (car pt-dummy) y-dummy (cadr pt-dummy))
               (setq x-end-dummy (+ x-dummy (/ (- y-dummy y-base) (sqrt 2.0))))
               (setq y-end-dummy (+ y-base  (/ (- y-dummy y-base) (sqrt 2.0))))
               (setq ang2 (angle (list x-end y-end)(list x-end-dummy y-end-dummy)))

               (command "move"   ssn  "" pt-start (list x-end y-end 0.0))
               (command "rotate" ssn  "" (list x-end y-end 0.0)(/ (* (- ang2 ang1) 180.0) pi))

               (setvar "osmode" oldosmode)
               (setvar "autosnap" oldautosnap)
         );progn1
      );if1

      (if (or(=  "RAY" (cdr (assoc 0 dxfdata)))(=  "XLINE" (cdr (assoc 0 dxfdata))));if1
         (progn;1
              
               (setq pt-start (cdr (assoc 10 dxfdata)))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
            
                  (setq pt-dummy (cdr (assoc 11 dxfdata)))      
               (setq x-dummy (+ (car pt-dummy) x-start) y-dummy (+ (cadr pt-dummy) y-start))
               (setq x-end-dummy (+ x-dummy (/ (- y-dummy y-base) (sqrt 2.0))))
               (setq y-end-dummy (+ y-base  (/ (- y-dummy y-base) (sqrt 2.0))))
               (setq ang (angle (list x-end y-end)(list x-end-dummy y-end-dummy)))

               (setq dxfdata (subst (list 10 x-end y-end) (assoc 10 dxfdata) dxfdata))
               (setq dxfdata (subst (list 11
                                          (- (car  (polar (list x-end y-end) ang 1.0)) x-end)
                                          (- (cadr (polar (list x-end y-end) ang 1.0)) y-end)
                                    )
                                    (assoc 11 dxfdata) dxfdata
                             )
               )
               (entmod dxfdata)             
         );progn1
      );if1

      (if (= "SOLID" (cdr (assoc 0 dxfdata)));if1
         (progn;1
            (setq n 0)
            (repeat 4
               (setq pt-start (cdr (assoc (+ 10 n) dxfdata)))
               (setq x-start (car pt-start) y-start (cadr pt-start))
               (setq x-end (+ x-start (/ (- y-start y-base) (sqrt 2.0))))
               (setq y-end (+ y-base  (/ (- y-start y-base) (sqrt 2.0))))
                  
               (setq dxfdata (subst (list (+ 10 n) x-end y-end) (assoc (+ 10 n) dxfdata) dxfdata))
               (setq n (+ n 1))
            )
            (entmod dxfdata)             
         );progn1
      );if1
      
      (setq i (+ i 1))
   );repeat0
   (command "undo" "end")
   (princ)
);defun[/php]

LUCAS

祝賀wkai  升班竹了!  8-)

wkai

谢谢LUCAS老兄，希望以后多多支持！

to nuance:
欢迎以后多来交流。

dwgplt

谢谢！很好用，可有时出现下列提示，不知是怎么回事？另外，能不能也转换POLYLINE？
命令: pts

input plot scale 1:<100>:

选择对象: c

指定第一个角点: 指定对角点: 找到 42 个

选择对象:

base point:; 错误: DXF 组不正确: (48)

nuance

请楼上说明转换什么实体时出错.

得到一个积分真的很难,提供的程序用了我一周的时间,

dwgplt

转换LWPOLYLINE时出错，如果需要我可以把图发给你。
另外，每次要输入出图比例是否有必要？

nuance

把你的图发上来吧,lwpolyline形式太多,也许有没考虑到的情况.

出图比例只要按一次回车就行了,也不麻烦,
我的本意是控制精度,如果把分段数设为一个固定值,不是太好掌握,
数太小,弧线较长时,整体效果不好,若是数太大,弧线很短时,没必要,会影响运行速度,
我看可以这样,如果份数大于一定值,譬如200,则只分200份.
对了,楼上可以自己改程序啊.

dwgplt

我把图发上来，见附件。

nuance

已经改正,请重新下载附件.

dwgplt

谢谢！已经可以用了。如发现问题再请教。