求一个坐标展点程序老是出错求修改~~谢谢

flytoday · 发表于 2012-3-7 12:18:28

本帖最后由 flytoday 于 2013-5-9 14:42 编辑

如下两个是网上下的坐标展点程序

老是出现这个; 错误: 参数类型错误: numberp: nil
坐标数据

麻烦哪位高手帮帮忙修改能用下谢谢。。我的CAD是2006版本的

langjs · 发表于 2012-3-7 12:18:29

;;; dialog
(defun c:zd (/ a1 a2 a3 acaddocument acadobject acred activexpoint activextext1 activextext2 appsession arrayspace b1 b2 b3 b4 b5 b6
         c1 c2 c3 cass cassmode celldh cellgc cellgcv cellx celly col color111 count data dcl_id dialogloaded dialogresults
         dialogshow dmode echo filedir fileexten fn fp gcv gcva layersel len msxl-xl24hourclock name newlayer nm
         objectcreatemethod oldlayer out pointx pointxstr pointy pointystr pos1 pos2 pos3 pt ptslist relcol relrow result rng
         row rowall sarray strlength sysdrv tlb tlbfile tlbver userclick vladatapts vladatat1 vladatat2 xfile xlapp zdfs1 zdfs2
         zdfs3
      )          ; cad和cass模式自动识别自动识别是否带高程支持逗号分隔的txt文件展点 activex>entmake>command
         ; 此程序已经进行最优化
  (vl-load-com)
  (defun dsx-typelib-excel (/ sysdrv tlb)
(setq sysdrv (getenv "systemdrive"))
(cond
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
tlb
   )
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
tlb
   )
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
tlb
   )
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
   )
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office10\\Excel.exe")))
tlb
   )
)
  )
  (defun dsx-load-typelib-excel (/ tlbfile tlbver out)
(cond
   ((null msxl-xl24hourclock)
(if (setq tlbfile (dsx-typelib-excel))
   (progn
      (setq tlbver (substr (vl-filename-base tlbfile) 6))
      (cond
      ((= tlbver "9")
(princ "\n初始化 Microsoft Excel 2000...")
      )
      ((= tlbver "8")
(princ "\n初始化 Microsoft Excel 97...")
      )
      ((= (vl-filename-base tlbfile) "Excel.exe")
(princ "\n初始化 Microsoft Excel XP...")
      )
      )
      (vlax-import-type-library :tlb-filename tlbfile :methods-prefix "msxl-" :properties-prefix "msxl-" :constants-prefix
      "msxl-"
      )
      (if msxl-xl24hourclock
      (setq out t)
      )
   )
)
   )
   (t
(setq out t)
   )
)
out
  )
  (defun dsx-open-excel-exist (xfile dmode / appsession)
(princ "\n打开 Excel 电子表格文件...")
(cond
   ((setq fn (findfile xfile))
(cond
   ((setq appsession (vlax-get-or-create-object "Excel.Application"))
      (vlax-invoke-method (vlax-get-property appsession 'workbooks) 'open fn)
      (if (= (strcase dmode) "SHOW")
      (vla-put-visible appsession 1)
      (vla-put-visible appsession 0)
      )
   )
)
   )
   (t
(alert (strcat "\n不能找到指定的文件: " xfile))
   )
)
appsession
  )          ; 在活动的工作表中的单个单元格中获取数据
         ; 获取行<relrow> 和列 <relcol>范围内的单元格对象
  (defun dsx-excel-get-cell (rng relrow relcol)
(vlax-variant-value (msxl-get-item (msxl-get-cells rng) (vlax-make-variant relrow) (vlax-make-variant relcol)))
  )          ; 返回单元格(row, col)内容的值
  (defun dsx-excel-get-cellvalue (row col)
(vlax-variant-value (msxl-get-value (dsx-excel-get-cell (msxl-get-activesheet xlapp) row col)))
  )
  (setq *modelspace* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (defun list->variantarray (ptslist / arrayspace sarray) ; 给以双精度实数表示的二维点数组分配空间
(setq arrayspace (vlax-make-safearray vlax-vbdouble ; 元素类型
   (cons 0 (- (length ptslist) 1)) ; 数组维数
      )
)
(setq sarray (vlax-safearray-fill arrayspace ptslist)) ; 返回数组变体
(vlax-make-variant sarray)
  )
  (defun create_activex_point ()
(setq acadobject (vlax-get-acad-object)
   acaddocument (vla-get-activedocument acadobject)
)
(setq len (length nm))
(if (= (nth 2 dialogresults) 1)
   (progn
(setq count 0)
(setq layersel (vla-get-layers acaddocument))
(setq newlayer (vla-add layersel "zdh"))
(vla-put-activelayer acaddocument newlayer) ; (vla-put-color newlayer acred) ; (command "clayer" "zdh")
(while (< count len)
   (if (= cassmode 1)
      (progn
      (if (/= pos3 nil)
(setq vladatapts (list->variantarray (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100)
   (distof (nth count gcva))
      )
   )
)
(setq vladatapts (list->variantarray (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100)
   0
      )
   )
)
      )          ; end if
      )          ; end progn
      (progn
      (if (/= pos3 nil)
(setq vladatapts (list->variantarray (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) (distof (nth count gcva)))))
(setq vladatapts (list->variantarray (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) 0)))
      )
      )
   )          ; end if
   (setq activexpoint (vla-addpoint *modelspace* vladatapts)) ; 控制台下shirft+ctrl+space 显示所有vla-add函数
   (setq count (+ count 1))
)
   )
)          ; end if
(if (= (nth 1 dialogresults) 1)
   (progn
(setq count 0)          ; (command "clayer" "dh")
(setq layersel (vla-get-layers acaddocument))
(setq newlayer (vla-add layersel "dh"))
(vla-put-activelayer acaddocument newlayer) ; (vla-put-color newlayer acred)
(while (< count len)
   (if (= cassmode 1)
      (setq vladatat1 (list->variantarray (list (- (+ (* (nth 0 (nth count pt)) 2) 100) 4) (+ (* (nth 1 (nth count pt)) 2) 100)
      0
)
      )
      )
      (setq vladatat1 (list->variantarray (list (- (nth 0 (nth count pt)) 4) (nth 1 (nth count pt)) 0)))
   )          ; end if
   (setq activextext1 (vla-addtext *modelspace* (nth count nm) vladatat1 2))
   (setq count (+ count 1))
)
   )
)          ; end if
(if (and
   (= (nth 3 dialogresults) 1)
   (/= pos3 nil)
)
   (progn
(setq count 0)          ; (command "clayer" "gcd")
(setq layersel (vla-get-layers acaddocument))
(setq newlayer (vla-add layersel "gcd"))
(vla-put-activelayer acaddocument newlayer) ; (vla-put-color newlayer acred)
(while (< count len)
   (if (= cassmode 1)
      (progn
      (setq vladatat2 (list->variantarray (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100) 0)))
      )
      (progn
      (setq vladatat2 (list->variantarray (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) 0)))
      )
   )          ; end if
   (setq activextext2 (vla-addtext *modelspace* (nth count gcva) vladatat2 2))
   (setq count (+ count 1))
)
   )
)          ; end if

  )          ; _ end of defun
  (defun create_entmake_point ()
(setq len (length nm))
(if (= (nth 2 dialogresults) 1) ; 如果展位
   (progn
(setq count 0)
(setq a1 (cons 0 "point"))
(setq a3 (cons 8 "zdh"))
(setq color111 (cons 62 1))
(while (< count len)
   (if (= cassmode 1)
      (progn
      (if (/= pos3 nil)
(setq a2 (cons 10 (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100) (distof
   (nth count
         gcva
   )
   )
   )
   )
)
(setq a2 (cons 10 (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100) 0)))
      )          ; end if
      )          ; end progn
      (progn
      (if (/= pos3 nil)
(setq a2 (cons 10 (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) (distof (nth count gcva)))))
(setq a2 (cons 10 (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) 0)))
      )          ; end if
      )          ; end progn
   )          ; end if
   (entmake (list a1 a2 a3 color111))
   (setq count (+ count 1))
)          ; end while
   )
)          ; end if
(if (= (nth 1 dialogresults) 1)
   (progn
(setq count 0)
(setq b1 (cons 0 "text"))
(setq b4 (cons 40 2.0))
(setq b5 (cons 8 "dh"))
(setq b6 (cons 50 0))
(setq color111 (cons 62 1))
(while (< count len)
   (setq b2 (cons 1 (nth count nm)))
   (if (= cassmode 1)
      (setq b3 (cons 10 (list (- (+ (* (nth 0 (nth count pt)) 2) 100) 12) (+ (* (nth 1 (nth count pt)) 2) 100))))
      (setq b3 (cons 10 (list (- (nth 0 (nth count pt)) 12) (nth 1 (nth count pt)))))
   )
   (setq b3 (append
      b3
      (list 0)
   )
   )
   (entmake (list b1 b2 b3 b4 b5 b6 color111))
   (setq count (+ count 1))
)
   )
)          ; end if
(if (and
   (= (nth 3 dialogresults) 1)
   (/= pos3 nil)
)
   (progn
(setq count 0)
(setq b1 (cons 0 "text"))
(setq b4 (cons 40 2.0))
(setq b6 (cons 50 0))
(setq c1 (cons 8 "gcd"))
(setq color111 (cons 62 4))
(while (< count len)
   (setq c3 (cons 1 (nth count gcva)))
   (if (= cassmode 1)
      (setq c2 (cons 10 (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100))))
      (setq c2 (cons 10 (list (nth 0 (nth count pt)) (nth 1 (nth count pt)))))
   )
   (setq c2 (append
      c2
      (list 0)
   )
   )
   (entmake (list b1 c3 b4 b6 c1 c2 color111))
   (setq count (+ count 1))
)
   )
)          ; end if

  )          ; _ end of defun
  (defun create_command_point ()
(setq snap (getvar "osmode"))    ; 关闭捕捉
(setvar "osmode" 0)
(setq len (length nm))
(if (= (nth 2 dialogresults) 1)
   (progn
(setq count 0)
(command ".clayer" "zdh")
(while (< count len)
   (if (= cassmode 1)
      (progn
      (if (/= pos3 nil)
(command "point" (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100) (distof
   (nth count
      gcva
   )
   )
   )
)
(command "point" (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100) 0))
      )          ; end if
      )          ; end progn
      (progn
      (if (/= pos3 nil)
(command "point" (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) (distof (nth count gcva))))
(command "point" (list (nth 0 (nth count pt)) (nth 1 (nth count pt)) 0))
      )          ; end if
      )          ; end progn
   )          ; end if
   (setq count (+ count 1))
)
   )
)          ; end if
(if (= (nth 1 dialogresults) 1)
   (progn
(setq count 0)
(command ".layer" "n" "dh" "c" 1 "dh" "")
(command ".clayer" "dh")
(while (< count len)
   (if (= cassmode 1)
      (command "text" (list (- (+ (* (nth 0 (nth count pt)) 2) 100) 12) (+ (* (nth 1 (nth count pt)) 2) 100)) 2 0 (nth count nm))
      (command "text" (list (- (nth 0 (nth count pt)) 12) (nth 1 (nth count pt))) 2 0 (nth count nm))
   )          ; end if
   (setq count (+ count 1))
)
   )
)
(princ pos3);erase_dv
;; end if
(if (and
   (= (nth 3 dialogresults) 1)
   (/= pos3 nil)
)
   (progn
(setq count 0)
(command ".clayer" "gcd")
(while (< count len)
   (if (= cassmode 1)
      (command "text" (list (+ (* (nth 0 (nth count pt)) 2) 100) (+ (* (nth 1 (nth count pt)) 2) 100)) 2 0 (nth count gcva))
      (command "text" (list (nth 0 (nth count pt)) (nth 1 (nth count pt))) 2 0 (nth count gcva))
   )          ; end if
   (setq count (+ count 1))
)
   )
)          ; end if
(setvar "osmode" snap)          ; 恢复捕捉

  )          ; _ end of defun
  (defun dialoginput ()
(setq dialogloaded t)
(setq dialogshow t)
(setq zdfs1 0)
(setq zdfs2 0)
(setq zdfs3 0)
(if (= -1 (setq dcl_id (load_dialog "zzd1.dcl")))
   (progn          ; there's a problem - display a message and set the
         ; dialogloaded flag to nil
(princ "\nERROR: Cannot load gpdialog.dcl")
(setq dialogloaded nil)
   )          ; _ end of progn
)
(if (and
   dialogloaded
   (not (new_dialog "zddialog" dcl_id))
)          ; _ end of and
   (progn          ; there's a problem...
(princ "\nERROR: Cannot show dialog gp_mainDialog")
(setq dialogshow nil)
   )          ; _ end of progn
)
(if (and
   dialogloaded
   dialogshow
)
   (progn
(action_tile "gp_file" (strcat "(progn (setq  filedir  (getfiled \"打开文件\"  \" \" \"*\" 0))"
         "(SET_TILE \"gp_filename\" filedir))"
         )
)
(action_tile "gp_dh" "(setq zdfs1  1)")
(action_tile "gp_zb" "(setq zdfs2  1)")
(action_tile "gp_gc" "(setq zdfs3  1)") ; assign the actions (the functions to be invoked) to the dialog buttons
(action_tile "gp_actx" "(setq objectCreateMethod \"ActiveX\")") ; _ end of action_tile
(action_tile "gp_emake" "(setq objectCreateMethod \"Entmake\")") ; _ end of action_tile
(action_tile "gp_cmd" "(setq objectCreateMethod \"Command\")") ; _ end of action_tile
(action_tile "cancel" "(done_dialog) (setq UserClick nil)")
(action_tile "accept" "(done_dialog) (setq UserClick T))") ; _ end of action_tile
         ; now that everything is set and ready to go, invoke the dialog.
         ; once it is on-screen, it controls the program flow, until the
         ; user hits ok or cancel
(start_dialog)          ; ok or cancel has been hit, you're out of the dialog.  unload it
(unload_dialog dcl_id)          ; check for the value of the variable userclick.  this determines if
         ; the user selected ok or cancel, and is represented by a value
         ; of t or nil
(if userclick          ; user clicked ok
         ; build the resulting data
   (progn
      (setq result (list))
      (setq result (cons objectcreatemethod result)) ; _ end of list
      (setq result (append
   result
   (list zdfs1 zdfs2 zdfs3)
   )
      )          ; _ end of setq
   )          ; _ end of progn
)          ; _ end of if
   )          ; _ end of progn
   result
)
  )
  (setq dmode "HIDE")
  (setq echo (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq cass (getvar "useri5"))
  (setq cassmode 0)
  (if (= cass 666)
(setq cassmode 1)
  )          ; (setq  filedir  (getfiled "打开文件"  "" "" 2))
         ; (setq fp (open filedir "r"))
  (setq dialogresults (dialoginput)) ; s所有返回值都在dialogrresults序列中
  (setq oldlayer (getvar "clayer"))
  (setq fileexten (vl-filename-extension filedir))
  (setq pt (list))
  (setq nm (list))
  (setq gcva (list))
  (setq rowall 2)
  (if (= fileexten ".xls")
(progn          ; (setq dmode "show")
   (dsx-load-typelib-excel)
   (setq xlapp (dsx-open-excel-exist filedir dmode)) ; 怎么获得行和列的总数？
   (while (/= (dsx-excel-get-cellvalue rowall 1) nil)
(setq celldh (dsx-excel-get-cellvalue 1 1)) ; 读取第一行第一列
(setq cellx (dsx-excel-get-cellvalue 1 2))
(setq celly (dsx-excel-get-cellvalue 1 3))
(setq cellgc (dsx-excel-get-cellvalue 1 4))
(setq rowall (+ rowall 1))
   )          ; end while 一直读到最后一行
   (setq nm (append
   (list celldh)
   nm
         )
   )
   (setq pt (cons (list cellx celly) pt))
   (setq cellgcv (rtos cellgc 2 3))
   (setq gcva (append
   (list cellgcv)
   gcva
   )
   )
   (setq pos3 1)
)
(progn
   (setq fp (open filedir "r"))
   (while (/= (setq data (read-line fp))
   nil
      )
(setq strlength (strlen data)) ; base 1
(setq pos1 (vl-string-search "," data)) ; 读出第一个，的位置
(setq name (substr data 1 pos1)) ; 由于vl-string-search base 是从 0开始而 substr  base是从1 开始
(setq pos2 (vl-string-search "," data (+ pos1 1))) ; 查找下一个,的位置
(setq pointxstr (substr data (+ pos1 2) (- pos2 pos1 1))) ; 提取x坐标的字符串
(setq pointx (atof pointxstr))
(if (= (setq pos3 (vl-string-search "," data (+ pos2 1)))
         nil
      )          ; 如果不带高程
   (progn
      (setq pointystr (substr data (+ pos2 2) (- strlength pos2 1)))
      (setq pointy (atof pointystr))
   )
   (progn
      (setq pointystr (substr data (+ pos2 2) (- pos3 pos2 1)))
      (setq pointy (atof pointystr))
      (setq gcv (substr data (+ pos3 2) (- strlength pos3 2)))
      (setq gcv (distof gcv))
      (setq gcv (rtos gcv 2 3))
   )
)          ; end if
         ; (command "clayer" "zdh")
         ; (command "layer" "set" "zdh" " ")
         ; (command "point" (list pointy  pointx  0) )
         ; (command "clayer" "dh")
         ; (command "layer" "set" "dh" " ")
         ; (command  "text" (list (- pointy  12) pointx  ) 2  0  name  )
         ; (command "clayer" "gcd")
         ; (command "layer" "set" "gcd" " ")
         ; (command  "text" (list  pointy pointx  ) 2  0  gcv )
         ; cond
(setq pt (cons (list pointy pointx) pt))
(setq nm (append
   (list name)
   nm
   )
)
(if (/= pos3 nil)
   (setq gcva (append
         (list gcv)
         gcva
      )
   )
)
   )
)          ; end progn
  )
  (if (= (tblsearch "layer" "dh") nil) ; 新建个文字层
(command "layer" "N" "dh" "C" 1 "dh" "")
  )
  (if (= (tblsearch "layer" "gcd") nil) ; 新建个文字层
(command "layer" "N" "gcd" "C" 4 "gcd" "")
  )
  (if (= (tblsearch "layer" "zdh") nil) ; 新建个文字层
(command "layer" "N" "zdh" "C" 1 "zdh" "")
  )          ; end if
  (cond
((equal (strcase (car dialogresults)) "ACTIVEX")
   (create_activex_point)
)
((equal (strcase (car dialogresults)) "ENTMAKE")
   (create_entmake_point)
)
((equal (strcase (car dialogresults)) "COMMAND")
   (create_command_point)
)
(t
   nil
)
  )          ; end cond
  (command "clayer" oldlayer)
  (close fp)
  (setvar "cmdecho" echo)
  (princ)
)

flytoday · 发表于 2012-3-7 12:24:36

;CAD和CASS模式自动识别自动识别是否带高程支持逗号分隔的TXT文件展点 activex>entmake>command 此程序已经进行最优化

(vl-load-com)

(defun DSX-TypeLib-Excel ( / sysdrv tlb)
(setq sysdrv (getenv "systemdrive"))
(cond
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office10\\Excel.exe")))
tlb
)
)
)

(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
(cond
( (null msxl-xl24HourClock)
(if (setq tlbfile (DSX-TypeLib-Excel))
(progn
(setq tlbver (substr (vl-filename-base tlbfile) 6))
(cond
( (= tlbver "9")
(princ "\n初始化 Microsoft Excel 2000...") )
( (= tlbver "8")
(princ "\n初始化 Microsoft Excel 97...") )
( (= (vl-filename-base tlbfile) "Excel.exe")
(princ "\n初始化 Microsoft Excel XP...")
)
)
(vlax-import-type-library
:tlb-filename tlbfile
:methods-prefix "msxl-"
:properties-prefix "msxl-"
:constants-prefix "msxl-"
)
(if msxl-xl24HourClock (setq out T))
)
)
)
( T (setq out T) )
)
out
)

(defun DSX-Open-Excel-Exist (xfile dmode / appsession)
(princ "\n打开 Excel 电子表格文件...")
(cond
( (setq fn (findfile xfile))
(cond
( (setq appsession (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method
(vlax-get-property appsession 'WorkBooks)
'Open fn
)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)
)
( T (alert (strcat "\n不能找到指定的文件: " xfile)) )
)
appsession

)

;在活动的工作表中的单个单元格中获取数据

;;; 获取行<relrow> 和列 <relcol>范围内的单元格对象
(defun DSX-Excel-Get-Cell (rng relrow relcol)
(vlax-variant-value
(msxl-get-item (msxl-get-cells rng)
(vlax-make-variant relrow)
(vlax-make-variant relcol)
)
)
)
;返回单元格(row, col)内容的值

(defun DSX-Excel-Get-CellValue (row col)
(vlax-variant-value
(msxl-get-value
(DSX-Excel-Get-Cell
(msxl-get-ActiveSheet xlapp)
row col
)
)
)
)

(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument
               (vlax-get-Acad-Object))))

(defun list->variantArray (ptsList / arraySpace sArray)
  ; 给以双精度实数表示的二维点数组分配空间
  (setq arraySpace (vlax-make-safearray
            vlax-vbdouble ; 元素类型
            (cons 0
                  (- (length ptsList) 1)
                  ) ; 数组维数
            )
)
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
  ; 返回数组变体
  (vlax-make-variant sArray)
)

(defun Create_activeX_Point()
  (setq AcadObject(vlax-get-acad-object)

      AcadDocument(vla-get-ActiveDocument AcadObject)

  )

  (setq LEN (length NM))
  (if (= (nth 2 dialogResults) 1)
(progn
  (setq count 0)
  (setq  LayerSel ( vla-get-Layers AcadDocument))
  (setq  NewLayer (vla-add LayerSel "zdh"))
  (vla-put-ActiveLayer AcadDocument NewLayer)
  (vla-put-Color NewLayer acRed)
;(command "clayer" "zdh")
(while (< count LEN)
(if (= CASSMODE 1)
   (progn
      (if (/= pos3 nil)
   (setq VLADataPts (list->variantArray (list ( + ( * (nth  0 (nth count PT) )  2) 100) ( + ( * (nth  1 (nth count PT) ) 2) 100) (distof (nth count GCVA)) ) ) )
(setq VLADataPts (list->variantArray (list ( + ( * (nth  0 (nth count PT) )  2) 100) ( + ( * (nth  1 (nth count PT) ) 2) 100) 0 ) ) )
   );end if
   );end progn
   (progn
   (if (/= pos3 nil)
   (setq VLADataPts (list->variantArray (list (nth  0 (nth count PT) ) (nth  1 (nth count PT) )  (distof (nth count GCVA)) ) ) )
   (setq VLADataPts (list->variantArray (list (nth  0 (nth count PT) ) (nth  1 (nth count PT) )  0 ) ) )
   )
   )
);end if

(setq ACTIVEXPOINT (vla-AddPoint *ModelSpace*  VLADataPts )) ;控制台下shirft+ctrl+space 显示所有vla-add函数

(setq count (+ count 1))
)
  )
  );end if
  (if (= (nth 1 dialogResults) 1)
(progn
  (setq count 0)

  ;(command "clayer" "dh")
(setq  NewLayer (vla-add LayerSel "dh"))
  (vla-put-ActiveLayer AcadDocument NewLayer)
  (vla-put-Color NewLayer acRed)
  (while (< count LEN)
   (if (= CASSMODE 1)
   (setq VLADataT1 (list->variantArray(list (-  (  + ( * (nth  0 (nth count PT) ) 2 ) 100)  4)  ( + ( * (nth  1 (nth count PT) ) 2 ) 100 ) 0) ) )
   (setq VLADataT1 (list->variantArray(list (-  (nth  0 (nth count PT) )  4)  (nth  1 (nth count PT) ) 0) ) )
   );end if

(setq ACTIVEXTEXT1 (vla-AddText *ModelSpace*  (nth count NM) VLADataT1 2 ))
(setq count (+ count 1))
)
  )
);end if
  (if  (and (= (nth 3 dialogResults) 1) (/= pos3 nil))
(progn
  (setq count 0)
  ;(command "clayer" "gcd")
   (setq  NewLayer (vla-add LayerSel "gcd"))
  (vla-put-ActiveLayer AcadDocument NewLayer)
  (vla-put-Color NewLayer acRed)
  (while (< count LEN)
(if ( = CASSMODE 1 )
   (progn
(setq VLADataT2 (list->variantArray(list (+  (  * (nth  0 (nth count PT) ) 2) 100 ) ( + ( * (nth  1 (nth count PT) ) 2) 100 )  0 ) ) )
   )
   (progn
(setq VLADataT2 (list->variantArray(list (nth  0 (nth count PT) )  (nth  1 (nth count PT) ) 0 ) ) )
   )
   );end if

(setq ACTIVEXTEXT2 (vla-AddText  *ModelSpace*  (nth  count GCVA)  VLADataT2 2 ))
(setq count (+ count 1))
)
  )
);end if


);_ end of defun

(defun Create_entmake_Point()
  (setq LEN (length NM))
  (if(= (nth 2 dialogResults) 1);如果展位
(progn
  (setq count 0)
  (setq a1 (cons 0 "point"))
  (setq a3 (cons 8 "zdh"))
  (setq color (cons 62 1))
(while (< count LEN)
(if (= CASSMODE 1)
   (progn
   (if (/= pos3 nil)
      (setq a2 (cons 10 (list  (+ ( *  (nth  0 (nth count PT)) 2) 100 )  ( +( * (nth  1 (nth count PT) ) 2 ) 100)  (distof (nth count GCVA)))  ))
      (setq a2 (cons 10 (list  (+ ( *  (nth  0 (nth count PT)) 2) 100 )  ( +( * (nth  1 (nth count PT) ) 2 ) 100)  0 ) ))
      );end if
);end progn
   (progn
   (if (/= pos3 nil)
(setq a2 (cons 10 (list  (nth  0 (nth count PT)) (nth  1 (nth count PT) ) (distof (nth count GCVA)))  ))
(setq a2 (cons 10 (list  (nth  0 (nth count PT)) (nth  1 (nth count PT) ) 0 )  ))
   );END IF
   );end progn

   );END IF

(entmake (list a1 a2 a3 color))
(setq count (+ count 1))
);END WHILE
  )
  );end if
  (if (= (nth 1 dialogResults) 1)
(progn
  (setq count 0)
(setq b1 (cons 0 "text"))
  (setq b4 (cons 40 2.0))
   (setq b5 (cons 8 "dh"))
(setq b6 (cons 50  0))

  (while (< count LEN)
(setq b2 (cons 1 (nth count NM)))
(if (= CASSMODE 1)
(setq b3 (cons 10 (list (-  (+ ( * (nth  0 (nth count PT)) 2 ) 100 )  12) (+ ( * (nth  1 (nth count PT) ) 2) 100)  )))
   (setq b3 (cons 10 (list (-  (nth  0 (nth count PT))  12) (nth  1 (nth count PT) ) )))
   )
(setq b3 (append b3 (list 0)))
(entmake (list b1 b2 b3 b4 b5 b6 color ))
(setq count (+ count 1))
)
  )
);end if
  (if (and (= (nth 3 dialogResults) 1) (/= pos3 nil))
(progn
  (setq count 0)
   (setq c1 (cons 8 "gcd"))

  (while (< count LEN)
(setq c3 (cons 1 (nth count GCVA)))

(if ( = CASSMODE 1)
   (setq c2 (cons 10 (list ( + ( * (nth  0 (nth count PT)) 2) 100 )  ( + ( * (nth  1 (nth count PT) ) 2  ) 100) )))
(setq c2 (cons 10 (list (nth  0 (nth count PT))  (nth  1 (nth count PT) ) )))
   )
(setq c2 (append c2(list 0)))
(entmake (list b1 c3 b4 b6 c1 c2 color ))
(setq count (+ count 1))
)
  )
);end if
) ;_ end of defun

(defun Create_command_Point ()
  (setq LEN (length NM))
(if  (= (nth 2 dialogResults) 1)
  (progn
  (setq count 0)

  (command ".clayer" "zdh")
(while(< count LEN)
  ( if (= CASSMODE 1)
   (PROGN
   ( if (/= pos3 nil)
      (command "point" (list  (+ ( * (nth  0 (nth count PT) ) 2) 100)  (+ ( * (nth  1 (nth count PT) )2)100)  (distof (nth count GCVA))) )
   (command "point" (list ( + ( * (nth  0 (nth count PT) ) 2 )100) ( + ( * ( nth  1 (nth count PT) )2)100)  0) )
   );end if
   );end progn
   (progn
   (if (/= pos3 nil)
   (command "point" (list (nth  0 (nth count PT) )  (nth  1 (nth count PT) )  (distof (nth count GCVA))) )
   (command "point" (list (nth  0 (nth count PT) ) (nth  1 (nth count PT) )  0) )
   );end if
   );end progn
);END IF
(setq count (+ count 1) )
)
  )
  );end if
  (if (= (nth 1 dialogResults) 1)
(progn
(setq count 0)

(command ".layer" "n" "dh" "c" 1 "dh" "")
  (command ".clayer" "dh")
(while (< count LEN )
  ( if(= CASSMODE 1)

      (command  "text" (list (- (+(*(nth  0 (nth count PT) )2)100)  12)  (+(*(nth  1 (nth count PT) )2)100) )  2 0  (nth count NM)  )
(command  "text" (list (- (nth  0 (nth count PT) )  12)  (nth  1 (nth count PT) ) )  2 0  (nth count NM)  )

);END IF
(setq count (+ count 1) )
)
)
);end if
  (if(and  (= (nth 3 dialogResults) 1) (/= pos3 nil))
(progn
  (setq count 0)

  (command ".clayer" "gcd")
  (while  (< count LEN )
(if (= CASSMODE 1)
   (command  "text" (list (+(*(nth  0 (nth count PT) )2)100)  (+(*(nth  1 (nth count PT) )2)100) ) 2  0  (nth count GCVA)  )
(command  "text" (list (nth  0 (nth count PT) )  (nth  1 (nth count PT) ) ) 2  0  (nth count GCVA)  )
   );END IF
(setq count (+ count 1) )
  )
  )
  );end if
) ;_ end of defun

(defun dialoginput()
  (setq dialogLoaded T)
  (setq dialogShow  T)
  (setq zdfs1  0)
  (setq zdfs2  0)
  (setq zdfs3  0)

(if (= -1 (setq dcl_id (load_dialog "zzd1.dcl")))
(progn
   ;; There's a problem - display a message and set the
   ;; dialogLoaded flag to nil
   (princ "\nERROR: Cannot load gpdialog.dcl")
   (setq dialogLoaded nil)
) ;_ end of progn

  )
(if (and dialogLoaded
   (not (new_dialog "zddialog" dcl_id))
   ) ;_ end of and
(progn
   ;; There's a problem...
   (princ "\nERROR: Cannot show dialog gp_mainDialog")
   (setq dialogShow nil)
) ;_ end of progn
  )
(if (and dialogLoaded dialogShow)
(progn
   (action_tile
"gp_file"
(strcat "(progn (setq  filedir  (getfiled \"打开文件\"  \" \" \"*\" 0))"
   "(SET_TILE \"gp_filename\" filedir))"

   )
   )
   (action_tile
"gp_dh"
"(setq zdfs1  1)"
   )

   (action_tile
"gp_zb"
"(setq zdfs2  1)"
   )
   (action_tile
"gp_gc"
"(setq zdfs3  1)"
   )
   ;; Assign the actions (the functions to be invoked) to the dialog buttons
   (action_tile
"gp_actx"
"(setq objectCreateMethod \"ActiveX\")"
   ) ;_ end of action_tile
   (action_tile
"gp_emake"
"(setq objectCreateMethod \"Entmake\")"
   ) ;_ end of action_tile
   (action_tile
"gp_cmd"
"(setq objectCreateMethod \"Command\")"
   ) ;_ end of action_tile
   (action_tile "cancel" "(done_dialog) (setq UserClick nil)")
   (action_tile
"accept"
"(done_dialog) (setq UserClick T))"
   ) ;_ end of action_tile

   ;; Now that everything is set and ready to go, invoke the dialog.
   ;; Once it is on-screen, it controls the program flow, until the
   ;; user hits OK or cancel
   (start_dialog)

   ;; OK or cancel has been hit, you're out of the dialog.  Unload it
   (unload_dialog dcl_id)

   ;; Check for the value of the variable userClick.  This determines if
   ;; the user selected OK or cancel, and is represented by a value
   ;; of T or nil
   (if UserClick ; User clicked Ok
;; Build the resulting data

(progn
   (setq Result (list ))
   (setq Result (cons objectCreateMethod Result ) );_ end of list
   (setq Result (append Result (list zdfs1 zdfs2 zdfs3 ) ))
   ;_ end of setq
) ;_ end of progn
   ) ;_ end of if
) ;_ end of progn
  Result
  )

);dialog

(defun c:ZD()
(setq dmode "HIDE")
  (setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
  (setq CASS (getvar "useri5"))
(setq CASSMODE 0)
  (if (= CASS 666)
(setq CASSMODE 1)
)
;(setq  filedir  (getfiled "打开文件"  "" "" 2))
;(setq fp (open filedir "r"))
  (setq dialogResults (dialoginput));s所有返回值都在dialogrResults序列中
  (setq oldlayer (getvar "clayer"))
  (setq fileexten (vl-filename-extension filedir) )
(setq PT (list ))
  (setq NM (list ))
  (setq GCVA(list ))
  (setq ROWALL 2)
  (if (= fileexten ".xls")
( progn
   ;(setq dmode "SHOW")
(DSX-Load-TypeLib-Excel)
(setq xlapp  (DSX-Open-Excel-Exist filedir dmode))
;怎么获得行和列的总数？
(while (/= ( DSX-Excel-Get-CellValue  ROWALL 1 ) nil)
   (setq  CellDh ( DSX-Excel-Get-CellValue  1 1 )) ;读取第一行第一列
   (setq  CellX ( DSX-Excel-Get-CellValue  1 2 ))
   (setq  CellY ( DSX-Excel-Get-CellValue  1 3 ))
   (setq  CellGc ( DSX-Excel-Get-CellValue  1 4 ))
   (setq ROWALL (+ ROWALL 1))
   );end while 一直读到最后一行

  (setq NM (append (list CellDh) NM))
   (setq PT (cons (list CellX  CellY ) PT))
(setq CellGcv (rtos CellGc 2  3))
(setq GCVA (append (list CellGcv) GCVA))
(setq pos3 1 )

)


(progn

(setq fp (open filedir "r"))
  (while (/= (setq  data( read-line fp) ) nil )
(setq strlength (strlen data));base 1
(setq pos1 (vl-string-search  "," data  ) );读出第一个，的位置
(setq name (substr data 1 pos1) );由于vl-string-search base 是从 0开始而 substr  base是从1 开始

(setq pos2 (vl-string-search "," data (+ pos1 1)));查找下一个,的位置
(setq pointxstr (substr data (+ pos1 2) (- pos2 pos1 1 ) ));提取x坐标的字符串
(setq pointx (atof pointxstr) )

(if ( = (setq pos3 (vl-string-search "," data (+ pos2 1) )) nil);如果不带高程
   (progn
(setq pointystr (substr data (+ pos2 2) (- strlength pos2 1) ))
      (setq pointy (atof pointystr))
      )
   (progn
(setq pointystr (substr data (+ pos2 2)  (- pos3  pos2 1) ) )
(setq pointy (atof pointystr))

(setq gcv (substr data (+ pos3 2) (- strlength pos3 2) ))
(setq gcv (distof gcv ))
(setq gcv (rtos gcv 2 3))

)

);end if

;(command "clayer" "zdh")
;(command "layer" "set" "zdh" " ")
;(command "point" (list pointy  pointx  0) )

;(command "clayer" "dh")
;(command "layer" "set" "dh" " ")
;(command  "text" (list (- pointy  12) pointx  ) 2  0  name  )

;(command "clayer" "gcd")
;(command "layer" "set" "gcd" " ")

;(command  "text" (list  pointy pointx  ) 2  0  gcv )

  ;cond
(setq PT (cons (list pointy pointx ) PT))
(setq NM (append (list name) NM))
( if (/= pos3 nil)
(setq GCVA (append (list gcv) GCVA))
  )
)
);end progn
);end if

  (cond
   ((equal (strcase (car  dialogResults))  "ACTIVEX")
      (Create_activeX_Point)
   )
   ((equal (strcase (car dialogResults)) "ENTMAKE")
      (Create_entmake_Point)
   )
   ((equal (strcase (car dialogResults)) "COMMAND")
      (Create_command_Point)
   )
   (T    nil    )
   );end cond

  (command "clayer"  oldlayer)
  (close fp)
  (setvar "cmdecho" echo)
  )

flytoday · 发表于 2012-3-7 12:25:16

zddialog:dialog{
label="AUTOCAD实地和开思模式自动识别的坐标展点";
: row {       //文件打开对话框
: edit_box
{  label="文件目录 " ;
key="gp_filename" ;
edit_limit=16;
edit_width=25;
fixed_width=true;
value=""  ;
}
:button
{  label="打开" ;
  key="gp_file" ;
  width=10;
  fixed_width=true;
}

}

: boxed_radio_column {
label="选择展点内容";
  :row{
  :toggle{label="点号" ;  key="gp_dh" ;}
  :toggle{label="点位" ;  key="gp_zb" ;}
  :toggle{label="高程" ;  key="gp_gc" ; }
  }
}

: boxed_radio_column {    // 定义单选按钮区域
  label = "选择展点方式";
  :row{
  : radio_button {       // 定义 ActiveX 单选按钮
label = "&ActiveX";
key = "gp_actx";

}
: radio_button {       // 定义 (entmake) 单选按钮
  label = "&Entmake";
  key = "gp_emake";

}
: radio_button {       // 定义 (command) 单选按钮
  label = "&Command";
  key = "gp_cmd";
}
}
}
: row {       // 定义“OK”/“Cancel”按钮行
  : spacer { width = 1; }
  : button { // 定义“OK”按钮
label = "确定";
is_default = true;
key = "accept";
width = 8;
fixed_width = true;
  }
  : button { // 定义“Cancel”按钮
label = "取消";
is_cancel = true;
key = "cancel";
width = 8;
fixed_width = true;
  }
  : spacer { width = 1;}
}

}

yshf · 发表于 2012-3-7 13:05:17

本帖最后由 yshf 于 2012-3-7 13:10 编辑

1、“坐标数据.txt”文件中第五号点的数据“5,87795.51752842.551 ”缺少一个逗号，应该是“5,87795.517,52842.551 ”。
2、如果用“Entmake”展点时，出现错误：“命令: zd ; 错误: DXF 组不正确: nil”
3、如果用“ActiveX”展点时，出现错误：“命令: zd ; 错误: 参数类型错误: VLA-OBJECT nil"
4、如果数据文件选择Excel时，出现错误：“命令: zd打开 Excel 电子表格文件...; 错误: no function definition: MSXL-GET- ACTIVESHEET”
5、知道确切的循环次数，应该用repeat，据说它比while速度快

flytoday · 发表于 2012-3-7 13:12:50

上面这个也是下载的展点，，，参数类型错误: numberp: nil

这是为什么呢。。。。期待高手修正

flytoday · 发表于 2012-3-7 17:54:50

基本上各老师把我的问题都解决了。。谢谢明经的各位朋友各位老师。谢谢你们

flytoday · 发表于 2012-3-8 11:09:35

哪位老师帮帮忙…最好能用我那个文件测试下…谢谢

flytoday · 发表于 2012-3-8 18:52:52

哪位老师帮帮忙…最好能用我那个文件测试下…谢谢

flytoday · 发表于 2012-3-8 23:46:39

本帖最后由 flytoday 于 2012-3-9 00:30 编辑

langjs 发表于 2012-3-7 12:18
;;; dialog
(defun c:zd (/ a1 a2 a3 acaddocument acadobject acred activexpoint activextext1 activext ...

导入后缩小１０００倍，这个是因为坐标是按米标注滴哈哈..非常完美了哈哈..谢谢老师,,老师辛苦了谢谢

langjs 老师这贴绝对是精华中的精华..网上找了坐标展点就这个能用..精华..谢谢

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

[公告] 求一个坐标展点程序老是出错求修改~~谢谢

最佳答案

相关帖子

评分

本帖子中包含更多资源