jfh1
路人甲
路人甲
  • 注册日期2004-05-07
  • 发帖数38
  • QQ
  • 铜币57枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2783回复:6

取Pline实体各顶点坐标LISP源码

楼主#
更多 发布于:2004-07-12 13:08
<P><FONT color=#ee1111>  看到有人要200大元才给一个小程序,本人很是气愤,太黑了???用到这等小程序的都是穷人!大赚穷人的钱!<FONT color=#000000>黑</FONT>!!!! 打!!</FONT></P>
<P><FONT color=#ee1111>  下面是本人写的一段小程序,保证可以运行,只是个别机子上可能要加以修改--有关字体的地方!</FONT></P>
<P>;贾氏坐标注记程序;适合各种实体!!!各位可以稍加修改后用于,实体坐标存储、点号标注等
(defun C:zJ()  
        (setvar "cmdecho" 0)
        (setvar "osmode" 0)
        (COMMAND "-STYLE" "TTST" "SIMKAI.TTF" 0 0.9 0 "N" "N""")</P>
<P>        (setq SC (GETREAL "请输入标注字高<1.0>:"))
        (if (= sc nil)
            (setq sc 1)
   )
        (setq LABLE (entget(car (entsel "请选择要标注的实体:"))))
   (command "color" 5"")
        (while (SETQ la1 (assoc '10 LABLE))</P>
<P>          (SETQ la (CDR la1))
          (SETQ JJX (rtos (cadr la) 2 3))
(SETQ JJX (strcat "X=" JJX))
          (SETQ JJY (rtos (car la) 2 3))
(SETQ JJY (strcat "Y=" JJY))
     ;求标注文字的最大长度
   (setq lenx (* (+ (strlen jjx) 1) sc))
   (setq leny (* (+ (strlen jjy) 1) sc))
   (if (< lenx leny)
       (setq lenx leny)
     )
     ;求标注线水平段的长度
   (setq lenx (* lenx 0.65))
          (setq lb (list (+ (car la) (* 2 sc)) (+ (cadr la) (* 2 sc))))
          (setq lc (list (+ (car lb) lenx) (cadr lb)))
          (COMMAND "PLINE" la lb lc"")
          (command "Text" "j" "bl"  (list (+ (car lb) (* 0.5 sc)) (+ (cadr lb) (* 0.4 sc))) (* 1 sc) 0 JJX)
   (command "Text" "j" "tl"  (list (+ (car lb) (* 0.5 sc)) (- (cadr lb) (* 0.5 sc))) (* 1 sc) 0 JJy)
          (setq LABLE (CDR (MEMBER LA1 LABLE) ))
         )
   (command "color" "BYLAYER" "")
  )</P>
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2004-07-12 14:41
<img src="images/post/smile/dvbbs/em01.gif" />,共享大大滴ok
举报 回复(0) 喜欢(0)     评分
hisum
路人甲
路人甲
  • 注册日期2003-11-24
  • 发帖数488
  • QQ
  • 铜币1683枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2004-07-21 18:35
<P>你这程序你自己看懂了没?哪里有写pline顶点坐标的东西啊??!!!!这里是学习的地方,你不要把这里的空气给破坏了!!!!<img src="images/post/smile/dvbbs/em08.gif" /></P><P>(记得下次从别人那里偷程序的时候,也要把说明也一起偷上,不要搞得看不懂,丢人!)</P>
举报 回复(0) 喜欢(0)     评分
jfh1
路人甲
路人甲
  • 注册日期2004-05-07
  • 发帖数38
  • QQ
  • 铜币57枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2004-07-22 13:44
看不懂挎去运行一下就可以了吗?不会是连LISP程序怎么运行都不会吧?!!!
[此贴子已经被作者于2005-6-7 21:55:51编辑过]
举报 回复(0) 喜欢(0)     评分
jfh1
路人甲
路人甲
  • 注册日期2004-05-07
  • 发帖数38
  • QQ
  • 铜币57枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2004-07-25 10:19
<TABLE fixed; WORD-BREAK: break-all" width="90%" border=0><TR><TD 9pt; LINE-HEIGHT: 12pt" width="100%"><img src="http://www.gisempire.com/bbs/Skins/Default/topicface/face4.gif"> <B>[分享]</B>
<P><FONT face=隶书 color=#f73809 size=1>    这是我很多年以前写的一个小程序,可取出实体(主要是用来取PLINE线)二维坐标,并进行标注,也可称之为自动标注实体坐标,主要用来标注界址的平面坐标,现在我早已不再搞LISP了,基本上也不再写代码了!这样的程序还有好多好多,在生产上曾起到过很重要的作用,丢掉了实在可惜,今后将在论坛上相继发表,<FONT color=#0938f7>希望对各位能有所帮助!同时也希望各位看后发帖,</FONT>不过不要象<FONT color=#000000><b><EM><FONT face=新宋体>HISUM君</FONT></EM></b>,</FONT><FONT color=#f73809>不就是因为我开篇的那几句话吗?何必这样大动肝火?正如其所说,这里是学习的地方不是骂街的地方,我本意是帮助后学者,不领情也就罢了,何必如此!到这里来的基本上是搞技术的,保持一点技术人员的涵养是很必要的!能到这里看技术文章或程序的都不会是地痞。各位有什么需求也可以提,本人尽可能帮助(如编制一些程序,或解决技术问题),不过不要太长,我没有太多的时间!</FONT></FONT></P></TD></TR></TABLE><img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em15.gif" /><img src="images/post/smile/dvbbs/em15.gif" />
举报 回复(0) 喜欢(0)     评分
bluewood_cn
路人甲
路人甲
  • 注册日期2004-04-19
  • 发帖数118
  • QQ
  • 铜币551枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2004-08-15 14:19
<P>有关AutoCAD 二次开发的东东,请倒 晓东CAD论坛上找。那上面在开发上面来说比较专业。我觉得我们这个AutoCAD 论坛,主要是涉及 怎样更好的 将AutoCAD 和 GIS结合起来,从而更好的满足客户,主要是针对GIS 行业的应用。</P>
举报 回复(0) 喜欢(0)     评分
xhpjq
路人甲
路人甲
  • 注册日期2004-07-24
  • 发帖数75
  • QQ
  • 铜币62枚
  • 威望0点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2004-08-15 22:54
<img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em08.gif" />
举报 回复(0) 喜欢(0)     评分
游客

返回顶部