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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 批量标注圆弧 代码有误，求助
返回列表 发新帖
查看: 4026|回复: 14

[求助] 批量标注圆弧 代码有误，求助

[复制链接]
杜流浪人

已领礼包: 720个

财富等级: 财运亨通
发表于 2016-1-26 22:13:48 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
各位老师好，写了一个批量标注圆弧长度的代码，执行错误。请各位老师给予指正 谢谢
(defun c:tt()
;以下文件由用户选择
(setvar "CMDECHO" 0)
(setq multi (getvar 'dimlfac));;;add 2002.5.15 can remove
(setq ss (ssget))
(setq l 10)
(setq n (sslength ss))
(repeat n
(setq en (ssname ss (1- n)))
(setq endata(entget en))
(setq entype (cdr (assoc 0 endata)))
(SETQ PC (cdr (ASSOC 10 endata))
  R   (cdr (ASSOC 40 endata))
  PT1 (polar pc (cdr (ASSOC 50 endata)) R)
  PT2 (polar pc (cdr (ASSOC 51 endata)) R)
  pmt(xyp-get-MidPoint pt1 pt2)
  ag(angle pc pmt)
  pt (polar pc ag (+ r l))
)
   (setq angs (assoc 50 endata))
   (setq angs (cdr angs))
   (setq ange (assoc 51 endata))
   (setq ange (cdr ange))
   (setq ang (- ange angs))
   (if (< ang 0)
     (setq ang (- (* 2 pi) (abs ang)))
   )
   (setq larc (* r ang))
   (setq larc (* larc multi));;;add 2002.2.20 can remove
  (setq larc  (rtos larc 2 1))
(command "dimangular"  en "t" larc pt1)
(setq n (1- n))
;;  (command "dimangular"  en "t" larc pt)
)  
(prin1)
)
;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
;; 两点之中点 (xyp-get-MidPoint p1 p2)
(defun xyp-get-MidPoint (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))



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

使用道具 举报

iLisp

已领礼包: 264个

财富等级: 日进斗金
发表于 2016-1-27 08:18:59 来自手机 | 显示全部楼层
command受osmode影响
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lisphk

已领礼包: 19个

财富等级: 恭喜发财
发表于 2016-1-27 09:15:42 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
加入  (setvar "osmode" 0)看看

点评

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

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
 楼主| 发表于 2016-1-27 15:17:59 | 显示全部楼层
Lisphk 发表于 2016-1-27 09:15
加入  (setvar "osmode" 0)看看


加上了   还是不行  

点评

XDSoft
错误提示是什么尼？  详情 回复 发表于 2016-1-27 15:26
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

XDSoft

已领礼包: 145个

财富等级: 日进斗金
发表于 2016-1-27 15:26:28 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
杜流浪人 发表于 2016-1-27 15:17
加上了   还是不行

错误提示是什么尼？

点评

杜流浪人
老大代码不执行标注圆弧  详情 回复 发表于 2016-1-28 17:39
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
 楼主| 发表于 2016-1-28 17:39:51 | 显示全部楼层
XDSoft 发表于 2016-1-27 15:26
错误提示是什么尼？

老大代码不执行标注圆弧

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

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2016-1-29 08:02:54 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 csharp 于 2016-1-29 08:16 编辑
杜流浪人 发表于 2016-1-28 17:39
老大代码不执行标注圆弧

  3. (defun c:tt (/           multi ss    l     n           en         endata             entype
  4.              pc           r         pt1   pt2   pmt   ag         pt    angs  ange
  5.              ang   larc         san   ean   man
  6.             )
  7.   ;;以下文件由用户选择
  8.   (setvar "CMDECHO" 0)
  9.   (setvar "osmode" (logior (getvar "osmode") 16384)) ;_取消捕捉，F3
  10.   (setq multi (getvar 'dimlfac))
  11.   ;;add 2002.5.15 can remove
  12.   (if (setq ss (ssget '((0 . "arc"))))
  13.     (progn
  14.       (setq l 10
  15.             n (sslength ss)
  16.       )
  17.       (repeat n
  18.         (setq en     (ssname ss (1- n))
  19.               endata (entget en)
  20.         )
  21.         ;;(setq entype (cdr (assoc 0 endata)))
  22.         (SETQ PC  (cdr (ASSOC 10 endata))
  23.               R          (cdr (ASSOC 40 endata))
  24.               san (cdr (assoc 50 endata)) ;_起点角度
  25.               ean (cdr (assoc 51 endata)) ;_终点角度
  26.               man (/ (+ san ean) 2) ;_中点角度
  27.               pt1 (polar pc san r) ;_起点
  28.               pt2 (polar pc ean r) ;_终点
  29.               pt  (polar pc man (+ r l)) ;_标注点
  30.                   ;;PT1 (polar pc (cdr (ASSOC 50 endata)) R)
  31.                   ;;PT2 (polar pc (cdr (ASSOC 51 endata)) R)
  32.                   ;;pmt (xyp-get-MidPoint pt1 pt2)
  33.                   ;;ag  (angle pc pmt)
  34.                   ;;pt  (polar pc ag (+ r l))
  35.         )
  36.         ;;(setq angs (assoc 50 endata))
  37.         ;;(setq angs (cdr angs))
  38.         ;;(setq ange (assoc 51 endata))
  39.         ;;(setq ange (cdr ange))
  40.         ;;(setq ang (- ange angs))
  41.         (setq ang (- ean san)) ;_夹角
  42.         (if (< ang 0)
  43.           (setq ang (- (* 2 pi) (abs ang)))
  44.         )
  45.         (setq larc (* r ang)
  46.               larc (* larc multi)
  47.               ;;add 2002.2.20 can remove
  48.               larc (rtos larc 2 1)
  49.         )
  50.         (command "dimangular" (list en pt1) "t" larc pt) ;_需要 (实体 点) 拾取方式
  51.         (setq n (1- n))
  52.         ;;  (command "dimangular"  en "t" larc pt)
  53.       )
  54.     )
  55.   )
  56.   (prin1)
  57. )
  58. ;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
  59. ;; 两点之中点 (xyp-get-MidPoint p1 p2)
  60. ;;(defun xyp-get-MidPoint        (p1 p2)
  61. ;;  (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))
  62. ;;)

进阶下这样写

  3. (defun c:tt (/ multi ss l n e sp ep len el san ean len pt)
  4.   (vl-load-com)
  5.   (if (setq ss (ssget '((0 . "arc"))))
  6.     (progn
  7.       (setvar "CMDECHO" 0)
  8.       (setvar "osmode" (logior (getvar "osmode") 16384)) ;_取消捕捉，F3   
  9.       (setq l          10
  10.             n          (sslength ss)
  11.             multi (getvar 'dimlfac)
  12.       )
  13.       (while (setq e (ssname ss (setq n (1- n))))
  14.         (setq sp  (vlax-curve-getstartpoint e)
  15.               ep  (vlax-curve-getendpoint e)
  16.               el  (entget e)
  17.               san (cdr (assoc 50 el))
  18.               ean (cdr (assoc 51 el))
  19.               len (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
  20.               pc  (cdr (assoc 10 (entget e))) ;_圆心
  21.               pt  (polar
  22.                     pc
  23.                     (angle pc
  24.                            (vlax-curve-getpointatparam e (/ (+ san ean) 2)) ;_中点
  25.                     )
  26.                     (+ (cdr (assoc 40 el)) l)
  27.                   )
  28.         )
  29.         (command "dimangular" (list en sp) "t" len pt) ;_需要 (实体 点) 拾取方式
  30.       )
  31.     )
  32.   )
  33.   (princ)
  34. )

点评

杜流浪人
谢谢老师 解释很清楚  详情 回复 发表于 2016-1-30 13:43
Lisphk
老大， (setvar "osmode" (logior (getvar "osmode") 16384)) ;_取消捕捉，F3 和 (setvar "osmode" 0)有什么区别？  详情 回复 发表于 2016-1-29 08:31
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

HLCAD

已领礼包: 5679个

财富等级: 富甲天下
发表于 2016-1-29 08:29:30 | 显示全部楼层
老大出手就是不一样
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lisphk

已领礼包: 19个

财富等级: 恭喜发财
发表于 2016-1-29 08:31:30 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
csharp 发表于 2016-1-29 08:02
进阶下这样写

老大， (setvar "osmode" (logior (getvar "osmode") 16384)) ;_取消捕捉，F3

和 (setvar "osmode" 0)有什么区别？

点评

csharp
0 就取消了用户设置，这个是临时取消，还可以恢复用户设置的模式 使用状态行的“对象捕捉”按钮关闭对象捕捉模式，除了返回 OSMODE 的普通值，还将返回位码 16384 (0x4000)。使用该附加值，开发人员可以将此模式  详情 回复 发表于 2016-1-29 08:42
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2016-1-29 08:42:00 | 显示全部楼层
Lisphk 发表于 2016-1-29 08:31
老大， (setvar "osmode" (logior (getvar "osmode") 16384)) ;_取消捕捉，F3

和 (setvar "osmode" 0 ...

0 就取消了用户设置，这个是临时取消，还可以恢复用户设置的模式

使用状态行的“对象捕捉”按钮关闭对象捕捉模式，除了返回 OSMODE 的普通值，还将返回位码 16384 (0x4000)。使用该附加值，开发人员可以将此模式与“草图设置”对话框中已关闭的对象捕捉模式区别开来。设置此位码值将关闭对象捕捉。在该位码值关闭时将 OSMODE 设置为**值可以打开对象捕捉。

使用 ActiveX 方法

  3. (defun c:tt (/ ss l n multi cdoc ms utility e obj totalangle len pt pc
  4.              dim)
  5.   (vl-load-com)
  6.   (if (setq ss (ssget '((0 . "arc"))))
  7.     (progn     
  8.       (setq l            10
  9.             n            (sslength ss)
  10.             multi   (getvar 'dimlfac)
  11.             cdoc    (vla-get-activedocument (vlax-get-acad-object))
  12.             ms            (vla-get-modelspace cdoc)
  13.             utility (vla-get-utility cdoc)
  14.       )
  15.       (while (setq e (ssname ss (setq n (1- n))))
  16.         (setq obj         (vlax-ename->vla-object e)
  17.               r                 (vla-get-radius obj)
  18.               pc         (vla-get-center obj)
  19.               totalangle (vla-get-totalangle obj)
  20.               len         (* r totalangle multi)
  21.               pt         (vla-polarpoint
  22.                            utility
  23.                            pc
  24.                            (/ totalangle 2)
  25.                            (+ r l)
  26.                          )
  27.               dim         (vla-adddimangular
  28.                            ms
  29.                            pc
  30.                            (vla-get-startpoint obj)
  31.                            (vla-get-endpoint obj)
  32.                            pt
  33.                          )
  34.         )
  35.         (vla-put-TextOverride dim (rtos len 2 1))
  36.       )
  37.     )
  38.   )
  39.   (princ)
  40. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2016-1-29 09:24:04 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 st788796 于 2016-1-29 09:28 编辑

用 Xdrxapi 是这样，原理都一样

  3. (defun c:tt (/ ss spa multi e pc sp ep len pt r dim san tolan)
  4.   (vl-load-com)
  5.   (if (setq ss (ssget '((0 . "arc"))))
  6.     (progn
  7.       (setq spa          10
  8.             multi (getvar 'dimlfac)
  9.       )
  10.       (xdrx_setsstodb ss 0);_选择集放入内部数据库
  11.       (while (setq e (xdrx_getentdata 0));_从内部数据库逐一取出实体
  12.         (mapcar        'set
  13.                 '(pc sp ep len r san tolan)
  14.                 (xdrx_getpropertyvalue
  15.                   e                 "Center"        "Startpoint"
  16.                   "EndPoint"         "Length"        "Radius"
  17.                   "StartAngle"         "ToTalAngle"
  18.                  );_获取需要的 Arc 各个属性
  19.         )
  20.         (setq pt (polar pc (+ san (/ tolan 2)) (+ r spa)))
  21.         (setq dim (xdrx_dimension_make2lang pc sp pc ep pt));_制造一个转角标注
  22.         (xdrx_setpropertyvalue
  23.           dim
  24.           "DimText"
  25.           (rtos (* len multi) 2 1)
  26.         );_将角度替换为长度值
  27.       )
  28.     )
  29.   )
  30.   (princ)
  31. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
 楼主| 发表于 2016-1-29 19:28:21 | 显示全部楼层
谢谢各位老师给予帮助   谢谢了   
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
 楼主| 发表于 2016-1-30 13:43:35 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
csharp 发表于 2016-1-29 08:02
进阶下这样写

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

使用道具 举报

杜流浪人

已领礼包: 720个

财富等级: 财运亨通
 楼主| 发表于 2016-2-1 09:57:59 | 显示全部楼层
经过学习   和修改  我的代码改成功了  谢谢各位老师的帮助  谢谢
(defun c:tt()
;以下文件由用户选择
(setvar "CMDECHO" 0)
(setvar "osmode" 0)
(setq multi (getvar 'dimlfac));;;add 2002.5.15 can remove
(setq ss (ssget))
(setq l 1)
(setq n (sslength ss))
(repeat n
(setq en (ssname ss (1- n)))
(setq endata(entget en))
(setq entype (cdr (assoc 0 endata)))
(SETQ PC (cdr (ASSOC 10 endata))
  R   (cdr (ASSOC 40 endata))
  PT1 (polar pc (cdr (ASSOC 50 endata)) R)
  PT2 (polar pc (cdr (ASSOC 51 endata)) R)
  pmt(PLF-get-MidPoint pt1 pt2)
  ag(angle pc pmt)
  pt (polar pc ag (+ r l))
)
          (setq angs (assoc 50 endata))
          (setq angs (cdr angs))
          (setq ange (assoc 51 endata))
          (setq ange (cdr ange))
          (setq ang (- ange angs))
          (if (< ang 0)
            (setq ang (- (* 2 pi) (abs ang)))
          )
          (setq larc (* r ang))
          (setq larc (* larc multi));;;add 2002.2.20 can remove
  (setq larc  (rtos larc 2 1))

(command "dimangular"  (list en pmt) "t" larc pt)
(setq n (1- n))
)               
(prin1)
)
;;&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
;; PLF-get-MidPoint 两点之中点 (xyp-get-MidPoint p1 p2)
(defun PLF-get-MidPoint (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))

点评

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

使用道具 举报

iLisp

已领礼包: 264个

财富等级: 日进斗金
发表于 2016-2-1 10:16:06 来自手机 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
杜流浪人 发表于 2016-2-1 09:57
经过学习   和修改  我的代码改成功了  谢谢各位老师的帮助  谢谢
(defun c:tt()
;以下文件由用户选择

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-27 16:25 , Processed in 0.422417 second(s), 58 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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