设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：xyp1964大师请进！
返回列表 发新帖
查看: 1566|回复: 11

[求助] [求助]：xyp1964大师请进！

[复制链接]
aichong
发表于 2006-3-25 11:33:40 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
这个lisp桩位编号程序为什么出错（编号漏了或编号重复了）？
(defun cent (p l / e cor)
(if (= "CIRCLE"
      (cdr (assoc 0 (setq e (entget (ssname p l))))))
   (progn
    (setq cor (cdr (assoc 10 e)))
    (setq x (car cor))
    (setq y (cadr cor))
   )
)
)
(defun bh (cen txt / nn h)
(setq nn (strlen (itoa txt)))
(cond ((= nn 1) (setq h 300))
       ((= nn 2) (setq h 180))
       ((= nn 3) (setq h 220))
       ((= nn 4) (setq h 200))
)
(command"TEXT" "j" "m"  cen  h  ag  txt)
)
;-------------------START11--------------------------------
(defun fs1 (/ ct ag n minx miny  x1 x2 y1 y2 cen l ll)
(setq ct 0 ag 90)
(setq n (sslength p))
(setq minx  1000000000)
(setq maxx -1000000000)
(while (/= miny 1000000000)
    (setq miny   1000000000)
    (setq x2     1000000000)
    (setq ll 0)
;-------------------------------------------------------
    (if (= ct 0)
     (progn
        (while (< ll n)
            (cent p ll)
            (if (< x minx) (setq minx x))
            (if (> x maxx) (setq maxx x))
            (setq ll (1+ ll))
        )
        (setq ct 1)
     )
     (progn
        (while (< ll n)
          (cent p ll)
          (if (and (> (- x minx) 11) (< x x2)) (setq x2 x))
          (setq ll (1+ ll))
        )
        (setq minx x2)
      )
    )
;--------------------------1111------------------------------
    (setq l 0)
    (while (< l n)
     (cent p l)
      (if (and (< (- x minx) 11) (> (- x minx) -11) (< y miny))
        (progn
          (setq miny y)
          (setq x1 x)
       )
     )
     (setq l (1+ l))
    )
    (setq cen (list x1 miny))
    (bh cen txt)
    (setq txt (1+ txt))
;-----------------------22222222222222----------------
    (setq l 0)
    (setq y2      10000000000)
    (while (/= y2 100000000000)
      (setq y2    100000000000)
      (setq ll 0)
      (while (< ll n)
         (cent p ll)
         (if (and (< (- x minx) 11) (> (- x minx) -11) (> y miny) (< y y2))
           (progn
             (setq y2 y)
             (setq x2 x)
           )
         )
         (setq ll (1+ ll))
     )
     (if (/= y2   100000000000)
      (progn
        (setq miny y2)
        (setq cen (list x2 y2))
        (bh cen txt)
        (setq txt (1+ txt))
      )
     )
    )
  )
)
;-----------------END-------------------------------
;-----------------START-----------------------------
(defun fs2 (/ ct ag n minx  maxy x1 x2 y1 y2 cen l ll)
(setq  ag 0 ct 0 i 1)
(setq miny     100000000000)
(setq maxy    -100000000000)
(setq n (sslength p))
(while (< minx 100000000000)
    (setq minx  100000000000)
    (setq y2   -100000000000)
    (setq ll 0)
;-----------------------------------------------'
    (if (= ct 0)
      (progn
           (while (< ll n)
             (cent p ll)
             (if (> y maxy) (setq maxy y))
             (if (< y miny) (setq miny y))
             (setq ll (1+ ll))
           )
        (setq ct 1)
      )
      (progn
           (while (< ll n)
             (cent p ll)
             (if (and (> (- maxy y) 11) (> y y2)) (setq y2 y))
             (setq ll (1+ ll))
           )
           (setq maxy y2)
      )
  )
;------------------11111---------------------
    (setq l 0)
    (while (< l n)
      (cent p l)
       (if (and (< (- maxy y) 11) (> (- maxy y) -11) (< x minx))
        (progn
          (setq minx x)
          (setq y1 y)
        )
       )
      (setq l (1+ l))
    )
    (setq cen (list minx y1))
    (bh cen txt)
    (setq txt (1+ txt))
    (setq i (1+ i))
;------------222222-------------------------
    (setq l 0 )
    (setq x2       10000)
    (while (< x2   100000000000)
      (setq x2     100000000000)
      (setq ll 0)
      (while (< ll n)
        (cent p ll)
        (if (and (< (- maxy y) 11) (> (- maxy y) -11) (> x minx) (< x x2))
           (progn
             (setq x2 x)
             (setq y2 y)
           )
         )
       (setq ll (1+ ll))
      )
      (if (< x2 100000000000)
       (progn
        (setq minx x2)
        (setq cen (list x2 y2))
        (bh cen txt)
        (setq txt (1+ txt))
       )
      )
    )
  )
)
;------------------END-----------------------
(defun C:Autonum( / p x y maxx miny ln ly  txt fs pt1 pt2 px1 px2 py1 py2 px py fw step)
(setq pt1 (getpoint"需自动编号范围的左下角坐标："))
(setq pt2 (getpoint"需自动编号范围的右上角坐标："))
(setq px1 (car pt1))
(setq px2 (car pt2))
(setq py1 (cadr pt1))
(setq py2 (cadr pt2))
(setq fs (strcase (getstring "\n编号顺序:L按列/H按行<H>:")))
(initget 4)
(setq txt (getint "\n起始桩号为:<1>"))
(if (null txt) (setq txt 1))
(setq fw 15)
(setq step 351)
(if (= fs "L")
  (progn
  (setq px  px1)
    (
     while (< px px2)
     (setq p (ssget  "c"  (list (- px fw) (- py1 1000))  (list (+ px fw) (+ py2 1000))))
     (if (/= p nil)
      (progn
       (fs1)
       (setq txt (- txt 1))
       (setq px maxx)
      )
     )
    (setq  px (+ px step))
   )
)
(progn
    (setq py py2)
    (
    while (> py py1)
     (setq p (ssget  "c"  (list (- px1 1000) (- py fw)) (list (+ px2 1000) (+ py fw))))
     (if (/= p nil)
      (progn
       (fs2)
       (setq txt (- txt 1))
       (setq py miny)
      )
     )
    (setq  py (- py step))
    )
  )
)
(setq p nil)
(setq ln nil)
(setq ly nil)
(setq x nil)
(setq y nil)
(setq txt nil)
(setq fs nil)
(setq pt1 nil)
(setq pt2 nil)
(setq px1 nil)
(setq px2 nil)
(setq py1 nil)
(setq py2 nil)
(setq px nil)
(setq py nil)
)

请下载附件的测试图纸试试：
setq, 100000000000, txt

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

xyp1964
发表于 2006-3-25 18:55:47 | 显示全部楼层
程序太长也看不懂！
试试下面的：
  2. [FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060314
  3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
  4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
  6. ■2·在每个程序内增加(load"xyp_lib.vlx")
  7. ■3·在command下，输入(load"xyp_lib.vlx")
  8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
  9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  10. [COLOR=red] ★通用函数下载地址：[/COLOR]
  11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  12. |;

  14. ;;;桩位编号
  15. (defun c:test ()
  16.   (CMDLASC0)
  17.   (if (null ukw)
  18.     (setq ukw "L")
  19.   )
  20.   (if (null int)
  21.     (setq int 1)
  22.   )
  23.   (princ "\n窗口选择需自动编号的范围: ")
  24.   (setq        ss  (ssget '((0 . "CIRCLE")))
  25.         ukw (UKWORD 7 "L H" "\n编号顺序 : L按列/H按行" ukw)
  26.         INT (UINT 1 "" "\n起始桩号为" INT)
  27.         i   0
  28.   )
  29.   (cond        ((= ukw "L") (setq plst (xyp-Sort ss 10 "X-min")))
  30.         ((= ukw "H") (setq plst (xyp-Sort ss 10 "Y-min")))
  31.   )
  32.   (mkla "桩位编号" 3)
  33.   (foreach pt plst
  34.     (setq i   (1+ i)
  35.           pt0 (car pt)
  36.     )
  37.     (xyp-Text 5 pt0 (rtos i 2 0))
  38.   )
  39.   (CMDLA1)
  40. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aichong
 楼主| 发表于 2006-3-25 21:22:19 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢xyp1964斑竹！
你编的不错！但编号排列不对，再麻烦你帮我修改一下，编号排列的形式见附图的效果：
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2006-3-25 23:03:06 | 显示全部楼层
  2. [FONT=courier new]
  3. (load "xyp_lib.vlx")  ;版本 V.20060325
  4. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
  5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  6. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
  7. ■2·在每个程序内增加(load"xyp_lib.vlx")
  8. ■3·在command下，输入(load"xyp_lib.vlx")
  9. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
  10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  11. [COLOR=red] ★通用函数下载地址：[/COLOR]
  12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  13. |;

  15. ;;;桩位编号
  16. (defun c:test ()
  17.   (CMDLASC0)
  18.   (if (null ukw)
  19.     (setq ukw "L")
  20.   )
  21.   (if (null int)
  22.     (setq int 1)
  23.   )
  24.   (princ "\n窗口选择需自动编号的范围: ")
  25.   (if (setq ss (ssget '((0 . "CIRCLE"))))
  26.     (progn
  27.       (setq ukw        (UKWORD 7 "L H" "\n编号顺序 : L按列/H按行" ukw)
  28.             INT        (UINT 1 "" "\n起始桩号为" INT)
  29.             lst        (xyp-Sort ss 10 "X-min")
  30.       )
  31.       (cond ((= ukw "L") (setq plst (xyp-Sort-PList lst 6)))
  32.             ((= ukw "H") (setq plst (xyp-Sort-PList lst 1)))
  33.       )
  34.       (mkla "桩位编号" 3)
  35.       (foreach pt plst
  36.         (xyp-Text 5 (car pt) (rtos int 2 0))
  37.         (setq int (1+ int))
  38.         (if (= ukw "L")
  39.           (command "rotate" (entlast) "" (car pt) 90)
  40.         )
  41.       )
  42.     )
  43.   )
  44.   (CMDLA1)
  45. )
  46. [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aichong
 楼主| 发表于 2006-3-25 23:54:15 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
斑竹，4楼的程序更加不行啊，怎么没有编号呢？
请下载附件的测试图纸试试：
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2006-3-26 00:02:43 | 显示全部楼层
最初由 aichong 发布
[B]斑竹，4楼的程序更加不行啊，怎么没有编号呢？
请下载附件的测试图纸试试： [/B]

请重新下载通用函数xyp_lib.vlx
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aichong
 楼主| 发表于 2006-3-26 00:09:01 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
我下载并加载了，但出现如下情况：
命令: (LOAD "D:/Documents and Settings/we/My
Documents/桩位编号程序/xyp_lib.VLX") nil
cad版本：2004chs
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2006-3-26 00:12:27 | 显示全部楼层
最初由 aichong 发布
[B]我下载并加载了，但出现如下情况：
命令: (LOAD "D:/Documents and Settings/we/My
Documents/桩位编号程序/xyp_lib.VLX") nil
cad版本：2004chs [/B]

正常，没问题！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aichong
 楼主| 发表于 2006-3-26 00:19:10 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
重新下载通用函数xyp_lib.vlx （20060325版本）后，这回可以了，正是我需要的效果。再次感谢xyp1964  大师的帮助！谢谢！！！
请教xyp1964 大师：能不能改进一下，使得其功能与下贴相同：
http://p4.xdcad.net/forum/showth ... 3092994#post3092994
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ji3499222
发表于 2007-1-20 23:12:07 | 显示全部楼层
想必这是为测量施工放线人员使用的程序，除了自动识别桩位（圆），并自动按从上到下，从左到右的规则编号外，下面的工作就是计算各桩位坐标，想说的是能否在此基础上自动计算出各桩位的坐标，并生成一个DAT文件，文件的格式是：
桩号 ，， Y坐标， X坐标， H高程

1 ，， 8325.333， 2564.123， 40.325
2 ，， ............ 依此类推

因为计算桩位坐标的工作量太大了，一般的工地都是几百棵桩到几千棵桩，计算完坐标后还要手工输入到仪器里去，如果能自动生成DAT文件，就可直接传输到仪器里去了，提高了工作效率，确保了数据的准确性。
烦请各位大师给予解决，非常的感谢！！！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

jx2008
发表于 2007-2-1 23:43:42 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
这个实现起来没问题，不难得，就是楼上的"H高程"这点可能有些不知道搂主的意思。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

cy956
发表于 2007-2-3 09:37:51 | 显示全部楼层
只要h数据记录方式合理，可以做到。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-17 19:50 , Processed in 0.246297 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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