超然A 发表于 2006-3-20 19:24:00

有没有用南方CASS做二次开发的？我有问题。

<P>有没有用南方CASS做二次开发的？我有问题。</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 我用南方CASS自己带的命令PUTP（加入实体编码，添加图元的扩展属性），结合一个文本文件（普通CAD下的图层和CASS图层、编码的对应表），实现图元自动添加扩展属性的功能。结果循环只能循环三次，超过4次循环就会出问题，弹出一个对话框“致命错误：命令嵌套超过4层”。</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 我试了一下，只用PUT命令进行循环（不结合文本文件来读取图层）没有问题，循环多少次都可以。而我把有PUT命令的这一行屏蔽掉，结果文本文件也可以全部读取出来。就是这两个组合在一起就出问题。不知道是为什么？</P>

willsnow1982 发表于 2007-11-18 10:55:00

(defun strParse (Str Delimiter / SearchStr StringLen return n char)
(setq SearchStr Str)
(setq StringLen (strlen SearchStr))
(setq return '())
(while (> StringLen 0)
    (setq n 1)
    (setq char (substr SearchStr 1 1))
    (while (and (/= char Delimiter) (/= char ""))
      (setq n (1+ n))
      (setq char (substr SearchStr n 1))
    )
    (setq return (cons (substr SearchStr 1 (1- n)) return))
    (setq SearchStr (substr SearchStr (1+ n) StringLen))
    (setq StringLen (strlen SearchStr))
)
(reverse return)
)
(defun C:ck ()
(regapp "south")
(regapp "流水号")
(regapp "部件名称")
(regapp "部件代码")
(regapp "状况")
(regapp "现势性")
(regapp "责任单位")
(regapp "材料")
(regapp "规格")
(regapp "类别")
(regapp "备注")
(setvar "cmdecho" 0)
(initget 6)
(setq bxm (getreal "\n请输入插入块的编码:"))
(setq bnm (rtos bxm 2 0))
(setq files (findfile "部件.txt"))
(if files
    (progn
      (setq biao nil)
      (setq fn (open files "r"))
      (while (setq x (read-line fn))
(setq biao (append biao (list x)))
      )
      (close fn)
    )
)
(setq lenbiao (length biao))
(setq m 0)
(while (< m lenbiao)
    (setq mxbiao (nth m biao))
    (setq line (strparse mxbiao ","))
    (setq cbm (nth 0 line))
    (if (= bnm cbm)   ;0
      (progn
(setq bbl (nth 1 line))
(setq btc (nth 2 line))
(setq bjmc (nth 3 line))
(setq bjdm (nth 4 line))
(setq bjzk (nth 5 line))
(setq bjxsx (nth 6 line))
(setq bjzrdw (nth 7 line))
(setq bjcl (nth 8 line))
(setq bjgg (nth 9 line))
(setq bjlb (nth 10 line))
(setq bjbz (nth 11 line))
(princ "\n您输入的编码为:")
(princ bnm)
(princ "●对应的图层为:")
(princ btc)
(princ "●对应地物名称为:")
(princ bjmc)
(setq bjr (getstring "\n确定<Y/n>?"))
(if (= "n" bjr)   ;1
   (progn
   (setq btc (getstring "\n请输入插入块的图层:<1>COMPONENT<2>手动输入"))
   (if (= btc "1")
       (progn
(setq btc "COMPONENT")
       )
   )
   (if (= btc "2")
       (progn
(setq btc (getstring "\n请输入插入块的图层:"))
       )
   )    ;if2
   )
)    ;if1
(setq bbm bnm)
      )
    )   ;if0
    (setq m (+ 1 m))
)   ;while
(setq bpt (getpoint "\n请输入插入块的位置:"))
(setq blk (strcat bbl ".dwg"))
(setq bkk (findfile blk))
   ;(setq ncode (list -3 (list "SOUTH" (cons 1000 bbm))))
(setq bls (getstring "\n请输入流水号:"))
(setq ncode (list -3 (list "SOUTH" (cons 1000 bbm)
   (cons 1001 "流水号")(cons 1000 bls)
   (cons 1001 "部件名称")(cons 1000 bjmc)
   (cons 1001 "部件代码")(cons 1000 bjdm)
   (cons 1001 "状况")(cons 1000 bjzk)
   (cons 1001 "现势性")(cons 1000 bjxsx)
   (cons 1001 "责任单位")(cons 1000 bjzrdw)
   (cons 1001 "材料")(cons 1000 bjcl)
   (cons 1001 "规格")(cons 1000 bjgg)
   (cons 1001 "类别")(cons 1000 bjlb)
   (cons 1001 "备注")(cons 1000 bjbz)
      )))
(if (not (tblsearch "layer" btc))
    (progn
      (command "layer" "m" btc "")
      (command "insert" blk bpt "0.5" "0.5" "0")
      (setq lbl (entlast))
      (setq bl (entget lbl))
      (if (setq ocode (assoc -3 bl))
(setq bl (subst bl ocode ncode))
(setq bl (append bl (list ncode)))
      )
      (entmod bl)
      (command "layer" "s" "0" "")
    )
)
(if (tblsearch "layer" btc)
    (progn
      (command "layer" "s" btc "")
      (command "insert" blk bpt "0.5" "0.5" "0")
      (setq lbl (entlast))
      (setq bl (entget lbl))
      (if (setq ocode (assoc -3 bl))
(setq bl (subst bl ocode ncode))
(setq bl (append bl (list ncode)))
      )
      (entmod bl)
      (command "layer" "s" "0" "")
    )
)
)
我自己写的一个用在我们部件调查的加属性块的程序。你要是会LISP的话，就能看懂了。

willsnow1982 发表于 2007-11-18 11:10:00

(defun strParse (Str Delimiter / SearchStr StringLen return n char)
(setq SearchStr Str)
(setq StringLen (strlen SearchStr))
(setq return '())
(while (> StringLen 0)
    (setq n 1)
    (setq char (substr SearchStr 1 1))
    (while (and (/= char Delimiter) (/= char ""))
      (setq n (1+ n))
      (setq char (substr SearchStr n 1))
    )
    (setq return (cons (substr SearchStr 1 (1- n)) return))
    (setq SearchStr (substr SearchStr (1+ n) StringLen))
    (setq StringLen (strlen SearchStr))
)
(reverse return)
)
(defun C:ck ()
(regapp "south")
(regapp "流水号")
(regapp "部件名称")
(regapp "部件代码")
(regapp "状况")
(regapp "现势性")
(regapp "责任单位")
(regapp "材料")
(regapp "规格")
(regapp "类别")
(regapp "备注")
(setvar "cmdecho" 0)
(initget 6)
(setq bxm (getreal "\n请输入插入块的编码:"))
(setq bnm (rtos bxm 2 0))
(setq files (findfile "部件.txt"))
(if files
    (progn
      (setq biao nil)
      (setq fn (open files "r"))
      (while (setq x (read-line fn))
(setq biao (append biao (list x)))
      )
      (close fn)
    )
)
(setq lenbiao (length biao))
(setq m 0)
(while (< m lenbiao)
    (setq mxbiao (nth m biao))
    (setq line (strparse mxbiao ","))
    (setq cbm (nth 0 line))
    (if (= bnm cbm)   ;0
      (progn
(setq bbl (nth 1 line))
(setq btc (nth 2 line))
(setq bjmc (nth 3 line))
(setq bjdm (nth 4 line))
(setq bjzk (nth 5 line))
(setq bjxsx (nth 6 line))
(setq bjzrdw (nth 7 line))
(setq bjcl (nth 8 line))
(setq bjgg (nth 9 line))
(setq bjlb (nth 10 line))
(setq bjbz (nth 11 line))
(princ "\n您输入的编码为:")
(princ bnm)
(princ "●对应的图层为:")
(princ btc)
(princ "●对应地物名称为:")
(princ bjmc)
(setq bjr (getstring "\n确定<Y/n>?"))
(if (= "n" bjr)   ;1
   (progn
   (setq btc (getstring "\n请输入插入块的图层:<1>COMPONENT<2>手动输入"))
   (if (= btc "1")
       (progn
(setq btc "COMPONENT")
       )
   )
   (if (= btc "2")
       (progn
(setq btc (getstring "\n请输入插入块的图层:"))
       )
   )    ;if2
   )
)    ;if1
(setq bbm bnm)
      )
    )   ;if0
    (setq m (+ 1 m))
)   ;while
(setq bpt (getpoint "\n请输入插入块的位置:"))
(setq blk (strcat bbl ".dwg"))
(setq bkk (findfile blk))
   ;(setq ncode (list -3 (list "SOUTH" (cons 1000 bbm))))
(setq bls (getstring "\n请输入流水号:"))
(setq ncode (list -3 (list "SOUTH" (cons 1000 bbm)
   (cons 1001 "流水号")(cons 1000 bls)
   (cons 1001 "部件名称")(cons 1000 bjmc)
   (cons 1001 "部件代码")(cons 1000 bjdm)
   (cons 1001 "状况")(cons 1000 bjzk)
   (cons 1001 "现势性")(cons 1000 bjxsx)
   (cons 1001 "责任单位")(cons 1000 bjzrdw)
   (cons 1001 "材料")(cons 1000 bjcl)
   (cons 1001 "规格")(cons 1000 bjgg)
   (cons 1001 "类别")(cons 1000 bjlb)
   (cons 1001 "备注")(cons 1000 bjbz)
      )))
(if (not (tblsearch "layer" btc))
    (progn
      (command "layer" "m" btc "")
      (command "insert" blk bpt "0.5" "0.5" "0")
      (setq lbl (entlast))
      (setq bl (entget lbl))
      (if (setq ocode (assoc -3 bl))
(setq bl (subst bl ocode ncode))
(setq bl (append bl (list ncode)))
      )
      (entmod bl)
      (command "layer" "s" "0" "")
    )
)
(if (tblsearch "layer" btc)
    (progn
      (command "layer" "s" btc "")
      (command "insert" blk bpt "0.5" "0.5" "0")
      (setq lbl (entlast))
      (setq bl (entget lbl))
      (if (setq ocode (assoc -3 bl))
(setq bl (subst bl ocode ncode))
(setq bl (append bl (list ncode)))
      )
      (entmod bl)
      (command "layer" "s" "0" "")
    )
)
)

这是我写的我们工作测区的一个程序，是给块加附加属性的。如果你会LISP的话，应该能看懂，按自己需要改吧。
页: [1]
查看完整版本: 有没有用南方CASS做二次开发的？我有问题。