设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [求助]dwg2shp
返回列表 发新帖
查看: 2255|回复: 4

[求助]dwg2shp

[复制链接]
hwang21
发表于 2006-8-2 19:42:00 | 显示全部楼层 |阅读模式

明经网站上有一个dwg转shp字体的软件，不知为何，不能下载。

大家有没有这个软件阿？传我一份，谢谢，最好有专家写成lisp，我学习一下。

如有，麻烦发至hwang21@163.com，如果是exe文件，记得压缩一下，或者改扩展名，我的邮箱不允许发送接受可执行文件，会识别为病毒。

回复

使用道具 举报

hwang21
 楼主| 发表于 2006-8-4 20:20:00 | 显示全部楼层

怎么没有人帮我？没有人有这个小软件吗？

顶上去，沉下去更没有希望了

回复 支持 反对

使用道具 举报

无痕
发表于 2006-8-4 21:43:00 | 显示全部楼层
  2.   
  3. ;  ###############################################################
  4. ;  ##  图形转换到形文件  功能软件  3．0  版      DWG-SHP.LSP    ##
  5. ;  ##  适用于 AutoCAD R13  以上版                               ##
  6. ;  ##  可转换的实体类型: 直线 _________ Line                    ##
  7. ;  ##                    圆弧 _________ Arc                     ##
  8. ;  ##                    圆 ___________ Circle                  ##
  9. ;  ##                                                           ##
  10. ;  ##  限制条件: 1> 每个端点都应尽量落在 1mm 的隐含网格上       ##
  11. ;  ##            2> 同一实体的两个相邻点 X,Y 位移小于 127mm     ##
  12. ;  ##            3> 直线中大于 127mm 的部分应分为 127mm 的几段  ##
  13. ;  ##            4> 大于半圆的弧应分两段绘成,  半径应是整数     ##
  14. ;  ##            5> 尽量少用 Arc，非用不可，应在最后绘成 ,      ##
  15. ;  ###############################################################
  17. ;-- ERROR 错误中断处理 --------------------------------------------
  18. (Defun CPrint (ipl / in)
  19.        (SetQ in 0)
  20.        (While (SetQ ipa (Nth in ipl))
  21.               (If (= 'REL (Type ipa)) (PrinC (RToS ipa)) (PrinC ipa))
  22.               (SetQ in (1+ in))
  23.        )
  24.        (PrinC)
  25. )
  26. (Defun Error (ex2 ey2 ex1 ey1 est / ea exx eyy)
  27.        (SetQ ea (Angle (List ex1 ey1) (List ex2 ey2))
  28.             exx (* 4 (Sin ea)) eyy (* 4 (Cos ea))
  29.        )
  30.        (GrDraw (List ex1 ey1) (List (- ex2 exx)(+ ey2 eyy)) 1 1)
  31.        (GrDraw (List (- ex2 exx)(+ ey2 eyy))
  32.                (List (+ ex2 exx)(- ey2 eyy)) 1 1)
  33.        (GrDraw (List (+ ex2 exx)(- ey2 eyy))(List ex1 ey1) 1 1)
  34.        (If (/= nil ofn3) (Close ofn3))
  35.        (If (/= nil ofn2) (Close ofn2))
  36.        (If (/= nil ofn1) (Close ofn1))
  37.        (Alert (StrCat "\n注意: \n" est "\n请重新修改你的图形，再试一次..."))
  38.        (SetQ ex1 nil ey1 nil ex2 ni ey2 nil)
  39.        (Redraw)(Abcdefg)
  40. )
  42. ;-- 2,8,(dx,dy), 空移的描述和处理 ---------------------------------
  44. (Defun 2-XY()
  45.        (SetQ 2a (Angle (List x0 y0)(List x1 y1))
  46.             2xx (* 2 (Sin 2a)) 2yy (* 2 (Cos 2a))
  47.        )
  48.        (GrDraw (List x1 y1) (List (- x0 2xx)(+ y0 2yy)) 3 1)
  49.        (GrDraw (List (- x0 2xx)(+ y0 2yy))
  50.                (List (+ x0 2xx)(- y0 2yy)) 3 1)
  51.        (GrDraw (List (+ x0 2xx)(- y0 2yy))(List x1 y1) 3 1)
  52.        (SetQ 2dx (- x1 x0) 2dy (- y1 y0) ax (Abs 2dx) ay (Abs 2dy))
  53.        (If (> 0.3 ax)(SetQ ax 0.0))
  54.        (If (> 0.3 ay)(SetQ ay 0.0))
  55.        (If (>= 2dx 0)(SetQ xfh "+")(SetQ xfh "-"))
  56.        (If (>= 2dy 0)(SetQ yfh "+")(SetQ yfh "-"))
  57.        (Cond ((Or (/= 0 2dx)(/= 0 2dy))                ;-> cond1
  58.              (Cond ((Or (> ax 127)(> ay 127))          ;-> cond1-1
  59.                    (Cond ((= ax ay)                    ;-> cond1-2
  60.                           (SetQ dn (RToS (/ ax 127) 2 0)
  61.                                ddd (RToS (rem ax 127) 2 0)
  62.                                sdy (StrCat "2,4," dn
  63.                                            ",8,(" xfh "127," yfh "127,)"
  64.                                            "3," dn
  65.                                            ",8,(" xfh ddd "," yfh ddd "),1,"
  66.                                    )
  67.                               sdyl (+ sdyl 12)
  68.                           )
  69.                           (Write-Line sdy ofn2) (SetQ sdy "")
  70.                          ) ;> ax=ay end
  71.                          ((= ax 0)
  72.                           (SetQ dn (RToS (/ ay 127) 2 0)
  73.                                ddd (RToS (rem ay 127) 2 0)
  74.                                sdy (StrCat "2,4," dn
  75.                                            ",8,(0," yfh "127,)"
  76.                                            "3," dn
  77.                                            ",8,(0," yfh ddd "),1,"
  78.                                    )
  79.                               sdyl (+ sdyl 12)
  80.                           )
  81.                           (Write-Line sdy ofn2) (SetQ sdy "")
  82.                          )  ;> ax=0 end
  83.                          ((= ay 0)
  84.                           (SetQ dn (RToS (/ ax 127) 2 0)
  85.                                ddd (RToS (rem ax 127) 2 0)
  86.                                sdy (StrCat "2,4," dn
  87.                                            ",8,(" xfh "127,0),"
  88.                                            "3," dn
  89.                                            ",8,(" xfh ddd ",0),1,"
  90.                                    )
  91.                               sdyl (+ sdyl 12)
  92.                           )
  93.                           (Write-Line sdy ofn2) (SetQ sdy "")
  94.                          ) ;> ay=0 end
  95.                          (T (Error x0 y0 x1 y1 "距离太长"))
  96.                       )                                 ;> cond1-2 end
  97.                    )                            ;> ax or ay > 127 end
  98.                    (T (SetQ sdy (StrCat "2,8,(" (RToS 2dx 2 0) ","
  99.                                                 (RToS 2dy 2 0) "),1,"
  100.                                 )
  101.                            sdyl (+ sdyl 5)
  102.                       )
  103.                       (Write-Line sdy ofn2)
  104.                    ) ;> ax and ay < 127 end
  105.              )  ;> cond1-1 end
  106.         )) ;> cond1 end
  107. (SetQ 2dx nil 2dy nil ddd nil xfh nil yfh nil))
  110. ;-- ARC 弧实体的转换 ----------------------------------------------
  112. (Defun S-Arc()
  113.        (PrinC "A.")
  114.        (SetQ cr (Cdr (Assoc 40 ent))
  115.               x (Cadr (Assoc 10 ent)) y (Caddr (Assoc 10 ent))
  116.              a1 (Cdr (Assoc 50 ent)) a2 (Cdr (Assoc 51 ent))
  117.             a11 (AToF (angtos a1 0 3)) a22 (AToF (angtos a2 0 3))
  118.              x1 (+ x (* cr (Cos a1))) y1 (+ y (* cr (Sin a1)))
  119.              x2 (+ x (* cr (Cos a2))) y2 (+ y (* cr (Sin a2)))
  120.              dx (- x2 x1) dy (- y2 y1)
  121.        )
  122.        (2-xy)
  123.        (Cond ((And (< (Abs dx) 127.0) (< (Abs dy) 127.0))
  124.              (setq d ( sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1)) ))
  125.                    h (- cr ( sqrt (- (* cr cr) (* 0.25 d d))))
  126.                    td  (* (/ (* 2.0 H) D) 127.0)
  127.              )
  128.              (setq dx (rtos dx 2 0) dy (rtos dy 2 0) td (rtos td 2 0) )
  129.              (SetQ sdy (StrCat "12," dx "," dy "," td ",")
  130.                   sdyl (+ sdyl 4)
  131.              )
  132.              (Write-Line sdy ofn2)
  133.         ;     (princ sdy)
  134.               (SetQ sdy "" x0 x2 y0 y2)
  135.              );-> cond T end
  136.              (T (Error x1 y1 x2 y2 "弧线太长 <S-Line>"))
  137.        );-> cond end
  138. )
  139. ;-- CIRCLE 圆实体的转换 -------------------------------------------
  141. (Defun S-Circle()
  142.        (PrinC "C.")
  143.        (SetQ cr (Cdr (Assoc 40 ent))
  144.              x1 (+ cr (Cadr (Assoc 10 ent))) y1 (Caddr (Assoc 10 ent))
  145.              cr (RToS cr 2 0)
  146.        )
  147.        (2-XY)
  148.       ; (SetQ sdy (StrCat "4," cr ",7,1,3," cr ",") sdyl (+ sdyl 6))
  149.        (SetQ sdy (StrCat "10," cr ",000," ) sdyl (+ sdyl 3))
  150.        (Write-Line sdy ofn2)(SetQ sdy "" x0 x1 y0 y1 cr nil)
  151. )
  153. ;-- LINE 直线实体的转换 -------------------------------------------
  155. (Defun S-Line()
  156.        (PrinC "L.")
  157.        (SetQ x1 (Cadr (Assoc 10 ent)) y1 (Caddr (Assoc 10 ent))
  158.              x2 (Cadr (Assoc 11 ent)) y2 (Caddr (Assoc 11 ent))
  159.              dx (- x2 x1) dy (- y2 y1)
  160.             ddx (RToS dx 2 0) ddy (RToS dy 2 0)
  161.        )
  162.        (2-XY)
  163.        (Cond ((And (< (Abs dx) 127) (< (Abs dy) 127))
  164.               (SetQ sdy (StrCat "8,(" ddx "," ddy "),") sdyl (+ sdyl 3))
  165.               (Write-Line sdy ofn2)
  166.              ; (princ sdy)
  167.               (SetQ sdy "" x0 x2 y0 y2)
  168.              );-> cond T end
  169.              (T (Error x1 y1 x2 y2 "线太长 <S-Line>"))
  170.        );-> cond end
  171.        (SetQ dx nil dy nil ddx nil ddy nil)
  172. )
  174. ;-- Write to SHP file 填写形文件 ----------------------------------
  176. (Defun Write-SHP()
  177.        (PrinC "\n正在写入形定义源文件...")
  178.        (Close ofn2)(SetQ ofn2 (open sfn2 "r") ofn1 (open sfn1 "a"))
  179.        (SetQ odyl (RToS (1+ sdyl) 2 0) osno (RToS sno 2 0)
  180.              obtl (StrCat "*" osno "," (rtos (+ 4 (atoi odyl)) 2 0) "," sna)
  181.        )
  182.        (Write-Line obtl ofn1)
  183.        (Write-Line "07,1," ofn1)
  184.        (While (SetQ txt (read-line ofn2)) (Write-Line txt ofn1))
  185.        (Write-Line "07,2,0" ofn1)
  186.        ;(Write-Line "0" ofn1)
  187.    ;    (Write-Line sna ofn3)
  188.        (Close ofn1) (Close ofn2) (Close ofn3)
  189.        (SetQ odyl nil odtl nil)
  190. )
  192. ;-- found *.nam file 形名索引的检索处理 & 输入限制 ----------------
  194. (Defun Name-File()
  195.        (SetQ ofn3 (Open sfn3 "r"))
  196.        (While (SetQ rsna (Read-Line ofn3))
  197.               (Cond ((= rsna sna)
  198.                      (PrinC "\n这个形名已经存在了!")
  199.                      (SetQ sna (GetString" 形名: ") sna (StrCase sna))
  200.                      (While (Or (Eq "" sna)(= "SAVE" sna)(= rsna sna))
  201.                             (PrinC "\n请重新起名...")
  202.                             (SetQ sna (GetString" 名: ") sna (StrCase sna))
  203.                      )
  204.                      (Close ofn3)
  205.                      (SetQ ofn3 (Open sfn3 "r"))
  206.                     );-> (= rsna sna)
  207.               ) ;-> cond end
  208.        );-> while end
  209.        (Close ofn3)
  210.        (SetQ ofn3 (Open sfn3 "a"))
  211. )
  213. ;== DWG to SHP 图 --> 形  转换功能的主控段落 ======================
  215. ;(Defun C:DWG-SHP ()
  216. (Defun C:DS ()
  217.       ; (Defun *error* (st) (SetQ *error* nil) (PrinC))
  218.        (SetQ sfn0 (GetString"\n形文件名: "));-> Input Filename
  219.        (While (Eq sfn0 "");-> "RETURN" err
  220.               (SetQ sfn0 (GetString"\n请确定形文件名: "))
  221.        );-> while end
  223.        (SetQ sfn1 (StrCat sfn0 ".SHP")
  224.              sfn2 (StrCat sfn0 ".BAK")
  225.              sfn3 (StrCat sfn0 ".NAM") sdy ""
  226.        )
  228.        (If (SetQ ofn3 (Open sfn3 "r"));-> new or old file
  229.            (Progn (SetQ sno 1)
  230.                   (While (Read-Line ofn3) (SetQ sno (1+ sno)))
  231.                   (PrinC "已有的形定义源文件...")(Close ofn3)
  232.            )
  233.            (Progn (SetQ ofn1 (Open sfn1 "w") ofn3 (Open sfn3 "w"))
  234.                   (Write-Line "C" ofn3)(Close ofn3)
  235.                   (Write-Line "*1,9,C" ofn1)
  236.                   (Write-Line "2,010,1,10,1,000,2,018,0" ofn1)
  237.                   (PrinC "新文件...") (SetQ sno 2)(Close ofn1)
  238.            )
  239.        )
  241.        (CPrint (List "\n形定义 [" sno))
  242.        (SetQ sna (StrCase (GetString"] 名: ")))
  243.        (While (Eq "" sna)
  244.               (SetQ sna (StrCase (GetString" 请输入形定义名: ")))
  245.        )
  247.        (While (And (/= "SAVE" sna)(> 255 sno));-> big while start
  248.               (SetQ ofn2 (Open sfn2 "w") sdyl 0)
  249.               (Name-File)
  250.               (SetQ ;inp (getpoint"\n插入基点: ")
  253.                      x0 (Car inp) y0 (Cadr inp) inp nil
  255.                      x0 0  y0 0
  256.               )
  257.               (PrinC "\n请选定要转换成形定义的图线 ...")
  258.               (SetQ ss (ssget))
  259.               (If (/= nil ss) (SetQ ssn (sslength ss)) (SetQ ssn 0))
  260.               (While (Or (Eq nil ss) (> ssn 1200))
  261.                      (PrinC "\n所选的图线个数是 ")
  262.                      (PrinC (RToS ssn 2 0))
  263.                      (PrinC "\n但是，图线数量限制在 1到 100之间！<dwg-shp>")
  264.                      (SetQ ss (ssget))
  265.                      (If (/= nil ss) (SetQ ssn (sslength ss)) (SetQ ssn 0))
  266.               )
  267.               (SetQ n (- ssn 1))
  268.               (repeat ssn
  269.                       (SetQ ent (EntGet (ssname ss n))
  270.                           etype (Cdr (Assoc 0 ent))
  271.                       )
  272.                       (Cond ((= etype "LINE")(S-Line))
  273.                             ((= etype "ARC")(S-Arc))
  274.                             ((= etype "CIRCLE")(S-Circle))
  275.                             (T (SetQ errp (Cdr (Assoc 10 ent))
  276.                                      errx (Car errp)
  277.                                      erry (Cadr errp)
  278.                                )
  279.                                (Error errx erry (+ errx 10) erry
  280.                                       (StrCat "所指图线中有不能转换的 " etype
  281.                                               "\n 能够转换的对象是:"
  282.                                               " Line、Circle 和 Arc"
  283.                                       )
  284.                                )
  285.                             )
  286.                       )
  287.                       (SetQ n (1- n))
  288.               )
  289.               (SetQ sno (1+ sno))(Write-SHP)
  290.               (PrinC "\nSAVE(存盘）/<形定义[") (PrinC sno)
  291.               (SetQ sna (StrCase (GetString"]名>: ")))
  292.               (While (Eq "" sna)
  293.                      (SetQ sna (StrCase (GetString" 请输入形定义名: ")))
  294.               )
  295.        );-> big while end
  297.        (PrinC "\n形文件: ")(PrinC (StrCase sfn0))
  298.        (PrinC ".SHP 已经存好了。")
  299.        (PrinC "\n感谢您使用我的程序，再见！")
  300.        (PrinC)
  301. )
  303. ;== By Chen Bo xiong =========================================================
回复 支持 反对

使用道具 举报

hwang21
 楼主| 发表于 2006-8-5 10:19:00 | 显示全部楼层
谢谢，很好用
回复 支持 反对

使用道具 举报

kk_2008
发表于 2008-12-14 09:21:00 | 显示全部楼层

如题。就是如何使用lsp将dwg文件中的实体坐标写到txt文件中，然后将经过平常以后的txt中的实体坐标写入到dwg文件中。

回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-7-30 05:29 , Processed in 0.195798 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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