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

zhanghuohuo · 发表于 2015-8-18 15:57:09

桥梁上面的一个插件，在使用钢束大样标注时，一直用不了：提示
”选择水平标注位置:; 错误: 参数类型错误: numberp: nil “。

程序为同济建筑设计院的开源程序，已联系不上作者。求高手看看。

———— 预应力工具
;;;===============================================================================
;;;-------------------------------------------------------------------------------
;;; 钢束初始化
;;; 功能：定义钢束
;;;-------------------------------------------------------------------------------
(defun c:gscsh(/ id whatnext tendonno count tcount tendonid tendonsty tendonstylst constress prelength orientstyle position symmertry
ename entlst vlaobj pto orient ptold orientold orientucs tcountold)
(defun showerrtile()
(cond
((or (null ename)(/= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
(mode_tile "accept" 1)
(set_tile "error" "未选中有效曲线！"))
(t
(mode_tile "accept" 0)
(set_tile "error" "OK！"))))
(setq id (load_dialog "BRTools.dcl")
tendonstylst '((0 . "15.20") (1 . "12.70") (2 . "11.10") (3 . "9.50") (4 . "JL18") (5 . "JL25") (6 . "JL32") (7 . "JL40")))
(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"))
(setq pto '(0.0 0.0 0.0)
ptold pto
orient (MAT:UnitVec2P '(0.0 0.0 0.0) (append (mapcar '+ '(0.0 0.0) (getvar "UCSXDIR")) '(0.0)))
orientold orient
orientucs orient
tcountold tcount)
(while (>= whatnext 2)
(new_dialog "SETTENDON" id)
(mapcar 'set_tile
'("tendonno" "count" "tendonsty" "constress" "prelength" "orientstyle" "position" "symmertry" "originmsg" "orientmsg")
(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)))
(LT:BUTTON-POINT-PICK "pickorigin" T)
(LT:BUTTON-SELECT-PICK "picktondon" T)
(if (= "currentucs" orientstyle)
(progn
(mode_tile "pickorient" 1)
(LT:BUTTON-POINT-PICK "pickorient" nil))
(progn
(mode_tile "pickorient" 0)
(LT:BUTTON-POINT-PICK "pickorient" T)))
(if (> tendonid 3)
(progn (mode_tile "tcount" 1) (set_tile "tcount" (itoa tcountold)))
(progn (mode_tile "tcount" 0) (set_tile "tcount" (itoa tcount))))
(showerrtile)
(action_tile "tendonno" "(setq tendonno $value)")
(action_tile "count" "(setq count (atoi $value))")
(action_tile "tcount" "(setq tcount (atoi $value))")
(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)))")
(action_tile "constress" "(setq constress (atof $value))")
(action_tile "prelength" "(setq prelength (atof $value))")
(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)")
(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)")
(action_tile "start" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")")
(action_tile "end" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")")
(action_tile "both" "(setq position (get_tile "position"))(mode_tile "symmetry" 0)(setq symmetry (get_tile "symmertry"))")
(action_tile "symmetry" "(setq symmertry $value)")
(action_tile "pickorient" "(done_dialog 4)")
(action_tile "pickorigin" "(done_dialog 3)")
(action_tile "picktondon" "(done_dialog 2)")
(action_tile "help" "(help "BRTools" "4_cmd_04_01_gscsh")")
(setq whatnext (start_dialog))
(cond
((= 4 whatnext)
(setq orientold orient)
(if (setq orient (getpoint (trans pto 0 1) "\n选择方向:"))
(setq orient (append (mapcar '+ '(0.0 0.0) (trans orient 1 0)) '(0.0))
orient (MAT:UnitVec2P pto orient)
orientold orient)
(setq orient orientold)))
((= 3 whatnext)
(setq ptold pto)
(if (setq pto (getpoint "\n请输入钢束参考点:"))
(setq pto (append (mapcar '+ '(0.0 0.0) (trans pto 1 0)) '(0.0))
ptold pto)
(setq pto ptold)))
((= 2 whatnext)
(and
(setq ename (car (entsel "\n选择一条曲线:")))
(CK:TendonP ename)
(mapcar
'(lambda(x1 x2 x3) (set x1 (BR:GetXdata ename x2 x3)))
'(tendonno tendonsty tcount count prelength constress position symmetry)
'(1000 1000 1070 1070 1040 1040 1000 1000)
'("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle"))
(setq pto (BR:GetOrigin ename)
orient (BR:GetOrient ename))))
((= 1 whatnext)
(LA:Rebar)
(setq entlst (entget ename)
vlaobj (vlax-ename->vla-object ename)
entlst (subst (cons 8 "REBAR") (assoc 8 entlst) entlst))
(entmod entlst)
(and (minusp (MAT:DotProduct orient (mapcar '- (vlax-curve-getEndPoint vlaobj) (vlax-curve-getStartPoint vlaobj)))) (MD:RevLwPl ename))
(mapcar
'(lambda(x1 x2 x3) (BR:SetXdata ename x1 x2 x3))
'(1000 1000 1070 1070 1040 1040 1000 1000)
'("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle")
(list tendonno tendonsty tcount count prelength constress position symmertry))
(BR:SetOrigin ename pto)
(BR:SetOrient ename orient))
((= 0 whatnext)(princ "\n操作取消！"))))
(unload_dialog id)
(princ))
;;;-------------------------------------------------------------------------------
;;; 钢束大样
;;; 功能：对预应力钢束大样进行标注
;;;-------------------------------------------------------------------------------
(defun c:gsdy (/ ename refename pt prolst dstyle)
(and
(setq ename (car (entsel "\n请选择钢束曲线:")))
(progn
(redraw ename 3)
(= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
(setq refename (car (entsel "\n请选择标注参考线:")))
(progn
(redraw refename 3)
(member (cdr (assoc 0 (entget refename))) '("LWPOLYLINE" "LINE")))
(cond
((CK:TendonP ename)(setq prolst (list (BR:GetOrient ename) (BR:GetXdata ename 1040 "prelength") (BR:GetXdata ename 1000 "tenposition") (BR:GetXdata ename 1000 "symmetrystyle"))))
(t (setq prolst (DL:GetTondonProLst '((0 . 700) (1 . "both") (2 . "1"))))))
(setq pt (trans (getpoint "\n选择水平标注位置:") 1 0))
(setq dstyle (getvar "DIMSTYLE"))
(progn
(or (tblsearch "DIMSTYLE" (strcat dstyle "$4")) (DSTYLE:Radial-Current))
(LA:CurNote)
(LA:CurCEN)
(LA:CurDim)
(LA:Rebar)
(BLK:PRESANCHOR)
(BLK:PRESTENSION)
(SET:SC))
(DR:TondonDim ename refename pt dstyle prolst))
(and ename (redraw ename 4))
(and refename (redraw refename 4))
(princ))
;;;-------------------------------------------------------------------------------
;;; 钢束导线
;;; 功能：画出钢束导线
;;;-------------------------------------------------------------------------------
(defun c:gsdx(/ r ss ename entlst i)
(setq r (getvar "FILLETRAD"))
(and
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn
(LA:CurCen)
(setvar "CMDECHO" 0)
(setvar "FILLETRAD" 0.0)
(setq i 0))
(repeat (sslength ss)
(setq entlst (entget (ssname ss i))
i (1+ i)
entlst (vl-remove-if '(lambda(x) (member (car x) '(-1 5 330 ))) entlst))
(entmake entlst)
(setq ename (entlast))
(vl-cmdf "fillet" "P" ename)
(vlax-put-property (vlax-ename->vla-object ename) 'LAYER *CLACEN*))
(setvar "FILLETRAD" r))
(princ))
;;;-------------------------------------------------------------------------------
;;; 钢束放样
;;; 功能：
;;;-------------------------------------------------------------------------------
(defun c:gsfy()
(princ))
;;;-------------------------------------------------------------------------------
;;;===============================================================================
;;;菜单命令 ———— 钢结构工具
;;;===============================================================================

———— 预应力<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a> 
;;;=============================================================================== 
;;;------------------------------------------------------------------------------- 
;;; 钢束初始化 
;;; 功能：定义钢束 
;;;------------------------------------------------------------------------------- 
(defun c:gscsh(/ id whatnext tendonno count tcount tendonid tendonsty tendonstylst constress prelength orientstyle position symmertry 
        ename entlst vlaobj pto orient ptold orientold orientucs tcountold) 
  (defun showerrtile() 
    (cond 
      ((or (null ename)(/= "LWPOLYLINE" (cdr (assoc 0 (entget ename))))) 
        (mode_tile "accept" 1) 
        (set_tile "error" "未选中有效曲线！")) 
      (t 
        (mode_tile "accept" 0) 
        (set_tile "error" "OK！")))) 
  (setq id            (load_dialog "BRTools.dcl") 
      tendonstylst '((0 . "15.20") (1 . "12.70") (2 . "11.10") (3 . "9.50") (4 . "JL18") (5 . "JL25") (6 . "JL32") (7 . "JL40"))) 
  (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")) 
  (setq pto      '(0.0 0.0 0.0) 
      ptold     pto 
      orient    (MAT:UnitVec2P '(0.0 0.0 0.0) (append (mapcar '+ '(0.0 0.0) (getvar "UCSXDIR")) '(0.0))) 
      orientold orient 
      orientucs orient 
      tcountold tcount) 
  (while (>= whatnext 2) 
    (new_dialog "SETTENDON" id) 
    (mapcar 'set_tile 
      '("tendonno" "count" "tendonsty" "constress" "prelength" "orientstyle" "position" "symmertry" "originmsg" "orientmsg") 
      (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))) 
    (LT:BUTTON-POINT-PICK "pickorigin" T) 
    (LT:BUTTON-SELECT-PICK "picktondon" T) 
    (if (= "currentucs" orientstyle) 
      (progn 
        (mode_tile "pickorient" 1) 
        (LT:BUTTON-POINT-PICK "pickorient" nil)) 
      (progn 
        (mode_tile "pickorient" 0) 
        (LT:BUTTON-POINT-PICK "pickorient" T))) 
    (if (> tendonid 3) 
      (progn (mode_tile "tcount" 1) (set_tile "tcount" (itoa tcountold))) 
      (progn (mode_tile "tcount" 0) (set_tile "tcount" (itoa tcount)))) 
    (showerrtile) 
    (action_tile "tendonno" "(setq tendonno $value)") 
    (action_tile "count" "(setq count (atoi $value))") 
    (action_tile "tcount" "(setq tcount (atoi $value))") 
    (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)))") 
    (action_tile "constress" "(setq constress (atof $value))") 
    (action_tile "prelength" "(setq prelength (atof $value))") 
    (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)") 
    (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)") 
    (action_tile "start" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")") 
    (action_tile "end" "(setq position (get_tile "position"))(mode_tile "symmetry" 1)(setq symmetry "0")") 
    (action_tile "both" "(setq position (get_tile "position"))(mode_tile "symmetry" 0)(setq symmetry (get_tile "symmertry"))") 
    (action_tile "symmetry" "(setq symmertry $value)") 
    (action_tile "pickorient" "(done_dialog 4)") 
    (action_tile "pickorigin" "(done_dialog 3)") 
    (action_tile "picktondon" "(done_dialog 2)") 
    (action_tile "help" "(help "BRTools" "4_cmd_04_01_gscsh")") 
    (setq whatnext (start_dialog)) 
    (cond 
      ((= 4 whatnext) 
        (setq orientold orient) 
        (if (setq orient (getpoint (trans pto 0 1) "\n选择方向:")) 
          (setq orient    (append (mapcar '+ '(0.0 0.0) (trans orient 1 0)) '(0.0)) 
              orient    (MAT:UnitVec2P pto orient) 
              orientold orient) 
          (setq orient orientold))) 
      ((= 3 whatnext) 
        (setq ptold pto) 
        (if (setq pto   (getpoint "\n请输入钢束参考点:"))   
          (setq pto   (append (mapcar '+ '(0.0 0.0) (trans pto 1 0)) '(0.0)) 
              ptold pto) 
          (setq pto ptold))) 
      ((= 2 whatnext) 
        (and 
          (setq ename (car (entsel "\n选择一条曲线:"))) 
          (CK:TendonP ename) 
          (mapcar 
            '(lambda(x1 x2 x3) (set x1 (BR:GetXdata ename x2 x3))) 
            '(tendonno tendonsty tcount count prelength constress position symmetry) 
            '(1000 1000 1070 1070 1040 1040 1000 1000) 
            '("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle")) 
          (setq pto    (BR:GetOrigin ename) 
              orient (BR:GetOrient ename)))) 
      ((= 1 whatnext) 
        (LA:Rebar) 
        (setq entlst (entget ename) 
            vlaobj (vlax-ename->vla-object ename) 
            entlst (subst (cons 8 "REBAR") (assoc 8 entlst) entlst)) 
        (entmod entlst) 
        (and (minusp (MAT:DotProduct orient (mapcar '- (vlax-curve-getEndPoint vlaobj) (vlax-curve-getStartPoint vlaobj)))) (MD:RevLwPl ename)) 
        (mapcar 
          '(lambda(x1 x2 x3) (BR:SetXdata ename x1 x2 x3)) 
          '(1000 1000 1070 1070 1040 1040 1000 1000) 
          '("tendonno" "tendonsty" "tcount" "count" "prelength" "constress" "tenposition" "symmetrystyle") 
          (list tendonno tendonsty tcount count prelength constress position symmertry)) 
        (BR:SetOrigin ename pto) 
        (BR:SetOrient ename orient)) 
      ((= 0 whatnext)(princ "\n操作取消！")))) 
  (unload_dialog id) 
  (princ))   
;;;------------------------------------------------------------------------------- 
;;; 钢束大样 
;;; 功能：对预应力钢束大样进行标注 
;;;------------------------------------------------------------------------------- 
(defun c:gsdy (/ ename refename pt prolst dstyle) 
  (and 
    (setq ename (car (entsel "\n请选择钢束曲线:"))) 
    (progn 
      (redraw ename 3) 
      (= "LWPOLYLINE" (cdr (assoc 0 (entget ename))))) 
    (setq refename (car (entsel "\n请选择标注参考线:"))) 
    (progn 
      (redraw refename 3) 
      (member (cdr (assoc 0 (entget refename))) '("LWPOLYLINE" "LINE"))) 
    (cond 
      ((CK:TendonP ename)(setq prolst (list (BR:GetOrient ename) (BR:GetXdata ename 1040 "prelength") (BR:GetXdata ename 1000 "tenposition") (BR:GetXdata ename 1000 "symmetrystyle")))) 
      (t (setq prolst (DL:GetTondonProLst '((0 . 700) (1 . "both") (2 . "1")))))) 
    (setq pt (trans (getpoint "\n选择水平标注位置:") 1 0)) 
    (setq dstyle (getvar "DIMSTYLE")) 
    (progn 
      (or (tblsearch "DIMSTYLE" (strcat dstyle "$4")) (DSTYLE:Radial-Current)) 
      (LA:CurNote) 
      (LA:CurCEN) 
      (LA:CurDim) 
      (LA:Rebar) 
      (BLK:PRESANCHOR) 
      (BLK:PRESTENSION) 
      (SET:SC)) 
    (DR:TondonDim ename refename pt dstyle prolst)) 
  (and ename (redraw ename 4)) 
  (and refename (redraw refename 4)) 
  (princ)) 
;;;------------------------------------------------------------------------------- 
;;; 钢束导线 
;;; 功能：画出钢束导线 
;;;------------------------------------------------------------------------------- 
(defun c:gsdx(/ r ss ename entlst i) 
  (setq r    (getvar "FILLETRAD")) 
  (and 
    (setq ss (ssget '((0 . "LWPOLYLINE")))) 
    (progn 
      (LA:CurCen) 
      (setvar "CMDECHO" 0) 
      (setvar "FILLETRAD" 0.0) 
      (setq i 0)) 
    (repeat (sslength ss) 
      (setq entlst (entget (ssname ss i)) 
          i      (1+ i) 
          entlst (vl-remove-if '(lambda(x) (member (car x) '(-1 5 330 ))) entlst)) 
      (entmake entlst) 
      (setq ename (entlast)) 
      (vl-cmdf "fillet" "P" ename) 
      (vlax-put-property (vlax-ename->vla-object ename) 'LAYER *CLACEN*)) 
    (setvar "FILLETRAD" r)) 
  (princ)) 
;;;------------------------------------------------------------------------------- 
;;; 钢束放样 
;;; 功能： 
;;;------------------------------------------------------------------------------- 
(defun c:gsfy() 
  (princ)) 
;;;------------------------------------------------------------------------------- 
;;;=============================================================================== 
;;;菜单命令 ———— 钢结构工具 
;;;===============================================================================

账号		自动登录	找回密码
密码			注册

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

本帖子中包含更多资源

相关帖子