找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 5879|回复: 65

[求助] 程序求助

[复制链接]
发表于 2013-11-1 17:00:40 来自手机 | 显示全部楼层 |阅读模式

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

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

×
我找到一个可以连续编号的lisp代码,但是有个问题不能设置自定义字高,求大神帮帮忙
(DEFUN C:XUHAO()
(setq n (getint "输入起始号:"))
(setq enttxt '((0 . "TEXT") (8 . "ZJ") (6 . "Continuous") (10 0.0 0.0 0.0) (40 . 0.7) (1 . "1") (50 . 0.0) (41 . 0.8) (51 . 0.0)(71 . 0) (72 . 4) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0)))
(setq pt (getpoint "输入标位置"))
(while (/= pt nil)
(setq enttxt2 (subst (cons 1 (rtos n 2 0)) '(1 . "1") (subst (append '(11) pt) '(11 0.0 0.0 0.0) enttxt)))
(entmake enttxt2)
(setq pt (getpoint "\n输入标位置"))
(setq n (+ n 1))
)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 7071个

财富等级: 富甲天下

发表于 2013-11-1 17:56:33 | 显示全部楼层
这儿改 (40 . 0.7)
0.7 改成新的字高
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-1 18:01:44 | 显示全部楼层
你没有增加高度的输入请求,以下需要 xdrxapi
  1. (defun c:xuhao (/ h n pt)
  2.   (if
  3.     (and (progn
  4.     (setq
  5.       h
  6.        (getdist
  7.   (strcat "\n字高<" (rtos (getvar "textsize") 2 2) ">:")
  8.        )
  9.     )
  10.     (or (and (= h "") (setq h (getvar "textsize")))
  11.         (and h (setvar "textsize" h))
  12.     )
  13.     t
  14.   )
  15.   (setq n (getint "\n起始序号: "))
  16.     )
  17.      (progn
  18.        (princ "\n输入位置: ")
  19.        (while (setq pt (getpoint))
  20.   (xdrx_text_make pt (itoa n) h 0.)
  21.   (setq n (1+ n))
  22.        )
  23.      )
  24.   )
  25.   (princ)
  26. )

点评

浠佸厔锛岄潪甯哥殑鎰熻阿浣犲憖锛屽府浜嗘垜澶у繖锛屾垜璇曚簡涓  详情 回复 发表于 2013-11-1 22:39
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-1 22:39:29 | 显示全部楼层
[quote][url=forum.php?mod=redirect&goto=findpost&pid=3494812&ptid=671393]st788796 鍙戣〃浜
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-1 22:55:14 来自手机 | 显示全部楼层
仁兄,非常感谢呀!帮了我大忙了。我对lisp比较陌生。还有个程序犯难。是个所有线段标注的程序,输完命令出来的数都是小数点四位数,怎么就能默认是整数了呢?
标注所有线段(加载后只需框选所有线段便可得标注这些线段)
  1. (defun c:LLL ()
  2.   (COMMAND "UCS" "")
  3.   (setvar "cmdecho" 1)
  4.   (SETVAR "OSMODE" 0)
  5.   (setq AcadObject (vlax-get-acad-object)
  6.         AcadDocument (vla-get-ActiveDocument Acadobject)
  7.         mSpace (vla-get-ModelSpace Acaddocument)
  8.   )                                       ; 选取需要测量的样条曲线、圆弧、直线?
  9.                                        ; ⑼衷?
  10.   (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
  11.   (setq i 0)                               ; 获取系统参数textsize
  12.   (setq shh (getvar "textsize"))
  13.   (setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))
  14.   (setq hh (getdist str_hh))
  15.   (while hh
  16.     (setvar "textsize" hh)
  17.     (setq hh nil)
  18.   )                                       ; 输入标注文字高度
  19.                                        ; 循环开始
  20.   (repeat (sslength en)
  21.     (setq ss (ssname en i))
  22.     (setq endata (entget ss))
  23.     (command "lengthen" ss "")
  24.     (setq dd (getvar "perimeter"))
  25.     (princ (strcat "\n长度=" (rtos dd 2))) ; 寻找代表图层的字符串
  26.     (setq aa (assoc 0 endata))               ; 获取图层名称
  27.     (setq aa1 (cdr aa))                       ; 判断线条种类
  28.     (cond
  29.       ((= aa1 "SPLINE")                       ; 如果是spline
  30.         (progn
  31.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  32.           (setq startPnt1 (vla-get-ControlPoints arcObj))
  33.           (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  34.           (setq x1 (car p1))
  35.           (setq y1 (cadr p1))
  36.           (setq z1 (caddr p1))
  37.           (setq pp1 (list x1 y1 z1))
  38.           (repeat (- (/ (length p1) 3) 1) ; 循环,寻找最后一个控制点
  39.             (setq p1 (cdddr p1))
  40.             (setq x2 (car p1))
  41.             (setq y2 (cadr p1))
  42.             (setq z2 (caddr p1))
  43.           )
  44.           (setq pp2 (list x2 y2 z2))
  45.         )
  46.       )
  47.       ((= aa1 "LWPOLYLINE")               ; 如果是LWPOLYLINE
  48.         (progn
  49.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  50.           (setq startPnt1 (vla-get-Coordinates arcObj))
  51.           (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  52.           (setq x1 (car p1))
  53.           (setq y1 (cadr p1))
  54.           (setq z1 (caddr p1))
  55.           (setq pp1 (list x1 y1 z1))
  56.           (repeat (- (/ (length p1) 3) 1) ; 循环,寻找最后一个控制点
  57.             (setq p1 (cdddr p1))
  58.             (setq x2 (car p1))
  59.             (setq y2 (cadr p1))
  60.             (setq z2 (caddr p1))
  61.           )
  62.           (setq pp2 (list x2 y2 z2))
  63.         )
  64.       )
  65.       (t                               ; 如果是其他种类线条
  66.         (progn
  67.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  68.           (setq startPnt1 (vla-get-StartPoint arcObj)) ; 获取起点
  69.           (setq endPnt1 (vla-get-EndPoint arcObj)) ; 获取终点
  70.           (setq pp1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  71.           (setq pp2 (vlax-safearray->list (vlax-variant-value endPnt1)))
  72.         )
  73.       )
  74.     )
  75.     (setq x1 (car pp1))
  76.     (setq y1 (cadr pp1))
  77.     (setq z1 (caddr pp1))
  78.     (setq x2 (car pp2))
  79.     (setq y2 (cadr pp2))
  80.     (setq z2 (caddr pp2))
  81.     (setq x (/ (+ x1 x2) 2))
  82.     (setq y (/ (+ y1 y2) 2))
  83.     (setq z (/ (+ z1 z2) 2))
  84.     (setq pt (list x y z))               ; 取得线段两端的中点
  85.     (setq ang (angle pp1 pp2))               ; 获取角度
  86.     (if (> (* (/ ang pi) 180) 180)
  87.       (setq ang (+ ang pi))
  88.     )
  89.     (command "text" "j" "bc" pt "" (* (/ ang pi) 180) (strcat ""
  90.                                                               (rtos dd 2)
  91.                                                       ) ""
  92.     )
  93.     (setq i (1+ i))
  94.   )
  95.   (prin1)
  96. )

  97. (prompt "\n <<length>>在图中直接写出长度")
  98. (prin1)


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

使用道具 举报

 楼主| 发表于 2013-11-1 22:59:51 来自手机 | 显示全部楼层
仁兄,非常感谢呀!帮了我大忙了。我对lisp比较陌生。还有个程序犯难。是个所有线段标注的程序,输完命令出来的数都是小数点四位数,怎么就能默认是整数了呢?
标注所有线段(加载后只需框选所有线段便可得标注这些线段)
  1. (defun c:LLL ()
  2.   (COMMAND "UCS" "")
  3.   (setvar "cmdecho" 1)
  4.   (SETVAR "OSMODE" 0)
  5.   (setq AcadObject (vlax-get-acad-object)
  6.         AcadDocument (vla-get-ActiveDocument Acadobject)
  7.         mSpace (vla-get-ModelSpace Acaddocument)
  8.   )                                       ; 选取需要测量的样条曲线、圆弧、直线?
  9.                                        ; ⑼衷?
  10.   (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
  11.   (setq i 0)                               ; 获取系统参数textsize
  12.   (setq shh (getvar "textsize"))
  13.   (setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))
  14.   (setq hh (getdist str_hh))
  15.   (while hh
  16.     (setvar "textsize" hh)
  17.     (setq hh nil)
  18.   )                                       ; 输入标注文字高度
  19.                                        ; 循环开始
  20.   (repeat (sslength en)
  21.     (setq ss (ssname en i))
  22.     (setq endata (entget ss))
  23.     (command "lengthen" ss "")
  24.     (setq dd (getvar "perimeter"))
  25.     (princ (strcat "\n长度=" (rtos dd 2))) ; 寻找代表图层的字符串
  26.     (setq aa (assoc 0 endata))               ; 获取图层名称
  27.     (setq aa1 (cdr aa))                       ; 判断线条种类
  28.     (cond
  29.       ((= aa1 "SPLINE")                       ; 如果是spline
  30.         (progn
  31.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  32.           (setq startPnt1 (vla-get-ControlPoints arcObj))
  33.           (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  34.           (setq x1 (car p1))
  35.           (setq y1 (cadr p1))
  36.           (setq z1 (caddr p1))
  37.           (setq pp1 (list x1 y1 z1))
  38.           (repeat (- (/ (length p1) 3) 1) ; 循环,寻找最后一个控制点
  39.             (setq p1 (cdddr p1))
  40.             (setq x2 (car p1))
  41.             (setq y2 (cadr p1))
  42.             (setq z2 (caddr p1))
  43.           )
  44.           (setq pp2 (list x2 y2 z2))
  45.         )
  46.       )
  47.       ((= aa1 "LWPOLYLINE")               ; 如果是LWPOLYLINE
  48.         (progn
  49.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  50.           (setq startPnt1 (vla-get-Coordinates arcObj))
  51.           (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  52.           (setq x1 (car p1))
  53.           (setq y1 (cadr p1))
  54.           (setq z1 (caddr p1))
  55.           (setq pp1 (list x1 y1 z1))
  56.           (repeat (- (/ (length p1) 3) 1) ; 循环,寻找最后一个控制点
  57.             (setq p1 (cdddr p1))
  58.             (setq x2 (car p1))
  59.             (setq y2 (cadr p1))
  60.             (setq z2 (caddr p1))
  61.           )
  62.           (setq pp2 (list x2 y2 z2))
  63.         )
  64.       )
  65.       (t                               ; 如果是其他种类线条
  66.         (progn
  67.           (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
  68.           (setq startPnt1 (vla-get-StartPoint arcObj)) ; 获取起点
  69.           (setq endPnt1 (vla-get-EndPoint arcObj)) ; 获取终点
  70.           (setq pp1 (vlax-safearray->list (vlax-variant-value startPnt1)))
  71.           (setq pp2 (vlax-safearray->list (vlax-variant-value endPnt1)))
  72.         )
  73.       )
  74.     )
  75.     (setq x1 (car pp1))
  76.     (setq y1 (cadr pp1))
  77.     (setq z1 (caddr pp1))
  78.     (setq x2 (car pp2))
  79.     (setq y2 (cadr pp2))
  80.     (setq z2 (caddr pp2))
  81.     (setq x (/ (+ x1 x2) 2))
  82.     (setq y (/ (+ y1 y2) 2))
  83.     (setq z (/ (+ z1 z2) 2))
  84.     (setq pt (list x y z))               ; 取得线段两端的中点
  85.     (setq ang (angle pp1 pp2))               ; 获取角度
  86.     (if (> (* (/ ang pi) 180) 180)
  87.       (setq ang (+ ang pi))
  88.     )
  89.     (command "text" "j" "bc" pt "" (* (/ ang pi) 180) (strcat ""
  90.                                                               (rtos dd 2)
  91.                                                       ) ""
  92.     )
  93.     (setq i (1+ i))
  94.   )
  95.   (prin1)
  96. )

  97. (prompt "\n <<length>>在图中直接写出长度")
  98. (prin1)


点评

找你程序中接近结束时候的 (rtos dd 2) 改成 (rtos dd 2 4) ,试试  详情 回复 发表于 2013-11-1 23:03
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-11-1 23:03:59 | 显示全部楼层
hphkjz 发表于 2013-11-1 22:59
仁兄,非常感谢呀!帮了我大忙了。我对lisp比较陌生。还有个程序犯难。是个所有线段标注的程序,输完命令出 ...

找你程序中接近结束时候的

(rtos dd 2)

改成 (rtos dd 2 4) ,试试

点评

仁兄,我lisp学艺不精,我想编一个程序,写固定字高的文字,不知道该怎么编的好  详情 回复 发表于 2013-11-3 05:34
仁兄我我试过了,没错,就是改后面的数,2后面加个4就是四位小数,变成0就显示整数了,真是不知道该怎么感谢你呀。  详情 回复 发表于 2013-11-3 05:26
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-2 06:19:16 来自手机 | 显示全部楼层
这程序写的也太初级了,API应用中有一个
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-3 05:26:48 | 显示全部楼层
newer 发表于 2013-11-1 23:03
找你程序中接近结束时候的

(rtos dd 2)

仁兄我我试过了,没错,就是改后面的数,2后面加个4就是四位小数,变成0就显示整数了,真是不知道该怎么感谢你呀。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-3 05:34:56 | 显示全部楼层
本帖最后由 hphkjz 于 2013-11-3 05:36 编辑
newer 发表于 2013-11-1 23:03
找你程序中接近结束时候的

(rtos dd 2)


仁兄,我lisp学艺不精,我想编一个程序,写固定字高的单行文字,不知道该怎么编的好{:soso_e121:}

点评

只需要把 "" 改成数值,注意字体设置时不可为固定高度 (command "text" "j" "bc" pt "" => (command "text" "j" "bc" pt 100 100替换为你要的高度  详情 回复 发表于 2013-11-3 06:26
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-3 06:26:48 来自手机 | 显示全部楼层
hphkjz 发表于 2013-11-3 05:34
仁兄,我lisp学艺不精,我想编一个程序,写固定字高的单行文字,不知道该怎么编的好

只需要把 "" 改成数值,注意字体设置时不可为固定高度

  (command "text" "j" "bc" pt ""  
=>
  (command "text" "j" "bc" pt 100

100替换为你要的高度

点评

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

使用道具 举报

 楼主| 发表于 2013-11-3 10:53:28 来自手机 | 显示全部楼层
st788796 发表于 2013-11-3 06:26
只需要把 "" 改成数值,注意字体设置时不可为固定高度

  (command "text" "j" "bc" pt ""  

感谢感谢!!!!!

点评

仁兄,又发现个问题,那个连续标注的程序字体离线太远,不知道怎么个改呢?  详情 回复 发表于 2013-11-3 21:31
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-3 21:31:03 来自手机 | 显示全部楼层
hphkjz 发表于 2013-11-3 10:53
感谢感谢!!!!!

仁兄,又发现个问题,那个连续标注的程序字体离线太远,不知道怎么个改呢?

点评

那是你标注样式设置问题  详情 回复 发表于 2013-11-4 00:16
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-4 00:16:25 来自手机 | 显示全部楼层
hphkjz 发表于 2013-11-3 21:31
仁兄,又发现个问题,那个连续标注的程序字体离线太远,不知道怎么个改呢?

那是你标注样式设置问题

点评

我看了看不是标注样式的,好像就是直接在直线上写的单行文字  详情 回复 发表于 2013-11-4 02:03
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-11-4 02:03:07 来自手机 | 显示全部楼层
st788796 发表于 2013-11-4 00:16
那是你标注样式设置问题

我看了看不是标注样式的,好像就是直接在直线上写的单行文字

点评

上面这部分代码是写文字的,变量PT是位置的点,你往上面找,看看给PT赋值的地方,自己尝试修改修改。  详情 回复 发表于 2013-11-4 08:32
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-9-25 02:27 , Processed in 0.443849 second(s), 67 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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