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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › cad标注问题（一个开源程序）
返回列表 发新帖
查看: 1099|回复: 7

[提问] cad标注问题（一个开源程序）

[复制链接]
zhanghuohuo
发表于 2015-8-18 15:57:42 | 显示全部楼层 |阅读模式
桥梁上面的一个插件，在使用  钢束大样   标注时，一直用不了：提示  
”选择水平标注位置:; 错误: 参数类型错误: numberp: nil “。

程序为 同济建筑设计院的 开源程序，已联系不上作者。求高手看看。
  2. ———— 预应力工具
  3. ;;;===============================================================================
  4. ;;;-------------------------------------------------------------------------------
  5. ;;; 钢束初始化
  6. ;;; 功能：定义钢束
  7. ;;;-------------------------------------------------------------------------------
  8. (defun c:gscsh(/ id whatnext tendonno count tcount tendonid tendonsty tendonstylst constress prelength orientstyle position symmertry
  9.         ename entlst vlaobj pto orient ptold orientold orientucs tcountold)
  10.   (defun showerrtile()
  11.     (cond
  12.       ((or (null ename)(/= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
  13.         (mode_tile "accept" 1)
  14.         (set_tile "error" "未选中有效曲线！"))
  15.       (t
  16.         (mode_tile "accept" 0)
  17.         (set_tile "error" "OK！"))))
  18.   (setq id            (load_dialog "BRTools.dcl")
  19.       tendonstylst '((0 . "15.20") (1 . "12.70") (2 . "11.10") (3 . "9.50") (4 . "JL18") (5 . "JL25") (6 . "JL32") (7 . "JL40")))
  20.   (mapcar 'set '(whatnext tendonno count tcount constress prelength orientstyle position symmertry tendonid tendonsty) '(2 "N1" 1 12 1395 700 "currentucs" "both" "0" 0 "15.20"))
  21.   (setq pto      '(0.0 0.0 0.0)
  22.       ptold     pto
  23.       orient    (MAT:UnitVec2P '(0.0 0.0 0.0) (append (mapcar '+ '(0.0 0.0) (getvar "UCSXDIR")) '(0.0)))
  24.       orientold orient
  25.       orientucs orient
  26.       tcountold tcount)
  27.   (while (>= whatnext 2)
  28.     (new_dialog "SETTENDON" id)
  29.     (mapcar 'set_tile
  30.       '("tendonno" "count" "tendonsty" "constress" "prelength" "orientstyle" "position" "symmertry" "originmsg" "orientmsg")
  31.       (list tendonno (itoa count) (itoa tendonid) (rtos constress 2) (rtos prelength 2) orientstyle position symmertry (vl-princ-to-string pto) (vl-princ-to-string orient)))
  32.     (LT:BUTTON-POINT-PICK "pickorigin" T)
  33.     (LT:BUTTON-SELECT-PICK "picktondon" T)
  34.     (if (= "currentucs" orientstyle)
  35.       (progn
  36.         (mode_tile "pickorient" 1)
  37.         (LT:BUTTON-POINT-PICK "pickorient" nil))
  38.       (progn
  39.         (mode_tile "pickorient" 0)
  40.         (LT:BUTTON-POINT-PICK "pickorient" T)))
  41.     (if (> tendonid 3)
  42.       (progn (mode_tile "tcount" 1) (set_tile "tcount" (itoa tcountold)))
  43.       (progn (mode_tile "tcount" 0) (set_tile "tcount" (itoa tcount))))
  44.     (showerrtile)
  45.     (action_tile "tendonno" "(setq tendonno $value)")
  46.     (action_tile "count" "(setq count (atoi $value))")
  47.     (action_tile "tcount" "(setq tcount (atoi $value))")
  48.     (action_tile "tendonsty" "(setq tendonid (atoi $value) tendonsty (cdr (assoc tendonid tendonstylst)))(if (> (atoi $value) 3) (progn (mode_tile "tcount" 1) (setq tcountold tcount tcount 0))(progn (mode_tile "tcount" 0) (setq tcount tcountold)))")
  49.     (action_tile "constress" "(setq constress (atof $value))")
  50.     (action_tile "prelength" "(setq prelength (atof $value))")
  51.     (action_tile "currentucs" "(setq orientstyle (get_tile "orientstyle") orientold orient orient orientucs)(set_tile "orientmsg" (vl-princ-to-string orient))(mode_tile "pickorient" 1)(LT:BUTTON-POINT-PICK "pickorient" nil)")
  52.     (action_tile "manualorient" "(setq orientstyle (get_tile "orientstyle") orient orientold ) (set_tile "orientmsg" (vl-princ-to-string orient)) (mode_tile "pickorient" 0)(LT:BUTTON-POINT-PICK "pickorient" T)")
  53.     (action_tile "start" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")")
  54.     (action_tile "end" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")")
  55.     (action_tile "both" "(setq position (get_tile "position"))(mode_tile "symmetry" 0)(setq symmetry (get_tile "symmertry"))")
  56.     (action_tile "symmetry" "(setq symmertry $value)")
  57.     (action_tile "pickorient" "(done_dialog 4)")
  58.     (action_tile "pickorigin" "(done_dialog 3)")
  59.     (action_tile "picktondon" "(done_dialog 2)")
  60.     (action_tile "help" "(help "BRTools" "4_cmd_04_01_gscsh")")
  61.     (setq whatnext (start_dialog))
  62.     (cond
  63.       ((= 4 whatnext)
  64.         (setq orientold orient)
  65.         (if (setq orient (getpoint (trans pto 0 1) "\n选择方向:"))
  66.           (setq orient    (append (mapcar '+ '(0.0 0.0) (trans orient 1 0)) '(0.0))
  67.               orient    (MAT:UnitVec2P pto orient)
  68.               orientold orient)
  69.           (setq orient orientold)))
  70.       ((= 3 whatnext)
  71.         (setq ptold pto)
  72.         (if (setq pto   (getpoint "\n请输入钢束参考点:"))  
  73.           (setq pto   (append (mapcar '+ '(0.0 0.0) (trans pto 1 0)) '(0.0))
  74.               ptold pto)
  75.           (setq pto ptold)))
  76.       ((= 2 whatnext)
  77.         (and
  78.           (setq ename (car (entsel "\n选择一条曲线:")))
  79.           (CK:TendonP ename)
  80.           (mapcar
  81.             '(lambda(x1 x2 x3) (set x1 (BR:GetXdata ename x2 x3)))
  82.             '(tendonno tendonsty tcount count prelength constress position symmetry)
  83.             '(1000 1000 1070 1070 1040 1040 1000 1000)
  84.             '("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle"))
  85.           (setq pto    (BR:GetOrigin ename)
  86.               orient (BR:GetOrient ename))))
  87.       ((= 1 whatnext)
  88.         (LA:Rebar)
  89.         (setq entlst (entget ename)
  90.             vlaobj (vlax-ename->vla-object ename)
  91.             entlst (subst (cons 8 "REBAR") (assoc 8 entlst) entlst))
  92.         (entmod entlst)
  93.         (and (minusp (MAT:DotProduct orient (mapcar '- (vlax-curve-getEndPoint vlaobj) (vlax-curve-getStartPoint vlaobj)))) (MD:RevLwPl ename))
  94.         (mapcar
  95.           '(lambda(x1 x2 x3) (BR:SetXdata ename x1 x2 x3))
  96.           '(1000 1000 1070 1070 1040 1040 1000 1000)
  97.           '("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle")
  98.           (list tendonno tendonsty tcount count prelength constress position symmertry))
  99.         (BR:SetOrigin ename pto)
  100.         (BR:SetOrient ename orient))
  101.       ((= 0 whatnext)(princ "\n操作取消！"))))
  102.   (unload_dialog id)
  103.   (princ))  
  104. ;;;-------------------------------------------------------------------------------
  105. ;;; 钢束大样
  106. ;;; 功能：对预应力钢束大样进行标注
  107. ;;;-------------------------------------------------------------------------------
  108. (defun c:gsdy (/ ename refename pt prolst dstyle)
  109.   (and
  110.     (setq ename (car (entsel "\n请选择钢束曲线:")))
  111.     (progn
  112.       (redraw ename 3)
  113.       (= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
  114.     (setq refename (car (entsel "\n请选择标注参考线:")))
  115.     (progn
  116.       (redraw refename 3)
  117.       (member (cdr (assoc 0 (entget refename))) '("LWPOLYLINE" "LINE")))
  118.     (cond
  119.       ((CK:TendonP ename)(setq prolst (list (BR:GetOrient ename) (BR:GetXdata ename 1040 "prelength") (BR:GetXdata ename 1000 "tenposition") (BR:GetXdata ename 1000 "symmetrystyle"))))
  120.       (t (setq prolst (DL:GetTondonProLst '((0 . 700) (1 . "both") (2 . "1"))))))
  121.     (setq pt (trans (getpoint "\n选择水平标注位置:") 1 0))
  122.     (setq dstyle (getvar "DIMSTYLE"))
  123.     (progn
  124.       (or (tblsearch "DIMSTYLE" (strcat dstyle "$4")) (DSTYLE:Radial-Current))
  125.       (LA:CurNote)
  126.       (LA:CurCEN)
  127.       (LA:CurDim)
  128.       (LA:Rebar)
  129.       (BLK:PRESANCHOR)
  130.       (BLK:PRESTENSION)
  131.       (SET:SC))
  132.     (DR:TondonDim ename refename pt dstyle prolst))
  133.   (and ename (redraw ename 4))
  134.   (and refename (redraw refename 4))
  135.   (princ))
  136. ;;;-------------------------------------------------------------------------------
  137. ;;; 钢束导线
  138. ;;; 功能：画出钢束导线
  139. ;;;-------------------------------------------------------------------------------
  140. (defun c:gsdx(/ r ss ename entlst i)
  141.   (setq r    (getvar "FILLETRAD"))
  142.   (and
  143.     (setq ss (ssget '((0 . "LWPOLYLINE"))))
  144.     (progn
  145.       (LA:CurCen)
  146.       (setvar "CMDECHO" 0)
  147.       (setvar "FILLETRAD" 0.0)
  148.       (setq i 0))
  149.     (repeat (sslength ss)
  150.       (setq entlst (entget (ssname ss i))
  151.           i      (1+ i)
  152.           entlst (vl-remove-if '(lambda(x) (member (car x) '(-1 5 330 ))) entlst))
  153.       (entmake entlst)
  154.       (setq ename (entlast))
  155.       (vl-cmdf "fillet" "P" ename)
  156.       (vlax-put-property (vlax-ename->vla-object ename) 'LAYER *CLACEN*))
  157.     (setvar "FILLETRAD" r))
  158.   (princ))
  159. ;;;-------------------------------------------------------------------------------
  160. ;;; 钢束放样
  161. ;;; 功能：
  162. ;;;-------------------------------------------------------------------------------
  163. (defun c:gsfy()
  164.   (princ))
  165. ;;;-------------------------------------------------------------------------------
  166. ;;;===============================================================================
  167. ;;;菜单命令 ———— 钢结构工具
  168. ;;;===============================================================================
开源程序, 设计院, 预应力, 建筑

相关帖子
回复

使用道具 举报

lucas_3333
发表于 2015-8-18 17:09:59 | 显示全部楼层
BRTools.dcl 对话框有放入吗?
回复 支持 反对

使用道具 举报

zhanghuohuo
 楼主| 发表于 2015-8-18 17:28:28 | 显示全部楼层
lucas_3333 发表于 2015-8-18 17:09
BRTools.dcl 对话框有放入吗?

(setq pt (trans (getpoint "\n选择水平标注位置:") 1 0))  ；输入  gsdy  命令。提示选择 选择水平标注位置 然后就显示   参数类型错误: numberp: nil “。
回复 支持 反对

使用道具 举报

spp_wall
发表于 2015-8-18 17:43:43 | 显示全部楼层
自定义函数缺少很多
回复 支持 反对

使用道具 举报

zhanghuohuo
 楼主| 发表于 2015-8-18 18:20:51 | 显示全部楼层
spp_wall 发表于 2015-8-18 17:43
自定义函数缺少很多

别人之前说可以用的！
回复 支持 反对

使用道具 举报

lostbalance
发表于 2015-8-18 23:02:18 | 显示全部楼层
楼主的源码应该没有贴全吧，缺少不少的自定义函数。如果原来其他地方可以用的话，估计是自定义函数专门打包放在另外一个文件了，没有拷贝上
回复 支持 反对

使用道具 举报

lostbalance
发表于 2015-8-23 23:50:37 | 显示全部楼层
zhanghuohuo 发表于 2015-8-18 17:28
(setq pt (trans (getpoint "\n选择水平标注位置:") 1 0))  ；输入  gsdy  命令。提示选择 选择水平标注位 ...

另外的一个帖子看了，竟然是整个自定义源码库其他程序能正常用的话，估计源码库没什么问题。
按照你给的cad提示，是不是这句话的执行有问题。
试试在上面的getpoint前后加上princ，手动检测下
(princ "\nok=1")
(setq p (getpoint "\n选择水平标注位置:") )
(princ "\nok=2")
(princ p);这个是查看取得的p是三维点还是二维点
(setq pt (trans p 1 0))
(princ "\nok=3")
然后看看显示的ok到哪一步，那么之后的那一步就有问题。这两个都是基础函数，如果有问题的话，要么函数格式有问题，要么参数的格式有问题，一个个排除下试试。
回复 支持 反对

使用道具 举报

zhanghuohuo
 楼主| 发表于 2015-8-24 12:21:31 | 显示全部楼层
lostbalance 发表于 2015-8-23 23:50
另外的一个帖子看了，竟然是整个自定义源码库其他程序能正常用的话，估计源码库没什么问题。
按照 ...

感谢！！虽然不知道你在说什么！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-23 07:03 , Processed in 0.194053 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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