求助选线,文字问题

nodbird · 发表于 2004-6-30 19:09:00

请问如何通过点选,将图中某个PL线顶点的坐标算出,并自动将X,Y坐标值分别旋转90度显示在指定位置上.

如某点(1452,4572)的X,Y值分别旋转90度显示在(1100.4000),(13000,4000)上.

主要是通过点选PL线可以实现.

小弟急需,请各位大侠帮助.

meflying · 发表于 2004-6-30 19:10:00

求程序还是求方法？

nodbird · 发表于 2004-7-1 16:08:00

方法程序都可以. 有程序当然最好了.

帮帮忙了，谢谢.

nodbird · 发表于 2004-7-1 16:56:00

选择PL线后实现如图,请飞哥帮忙过这一关.能实现主要的就可以了.

meflying · 发表于 2004-7-1 17:44:00

你在那个EXCEL里的请求，我已经把新改的程序写上了啊，，，，你没看吗？（就是加了写这些文字）

nodbird · 发表于 2004-7-1 18:38:00

看了,很好用,

但是问题的哪个人不是我啊,不过还是学到了不少.

我这个问题跟读取EXCEL无关,主要是选定任意PL线然后实现文字,就是4楼图上的样子.呵呵，虽然简单,但我总做不好,麻烦你了。

meflying · 发表于 2004-7-1 19:17:00

我给你的问题的程序也写好了的，怎么没有放上去？再贴一次，你好好看看，这里也有写文字的部分

(defun main( / filename sheet zin)
(setq zin (getvar "dimzin"))
(setvar "dimzin" 1)
(setq filename (getfiled "打开存放数据的Excel电子表格文档" "e:\\wjh\\study\\autolisp\\nodbird\" "XLS" 8))
(if filename
(progn
(setq appsession (Exl-Open filename "SHOW"))
(setq sheet (vlax-get-property appsession 'ActiveSheet))
(SETQ A (GetRange sheet "B5" "C20"))
(Exl-quit appsession)
(setq a (mapcar '(lambda(e) (if (not (vl-every 'null e)) e)) A))
(setq a (vl-remove nil a))
(draw a)
)
)
(setvar "dimzin" zin)
(princ)
)

nodbird · 发表于 2004-7-1 22:29:00

不行啊,执行加载EXCEL后,会提示错误: no function definition: EXL-OPEN,

另外单元格的行我可以任意修改吗.

nodbird · 发表于 2004-7-1 22:46:00

飞哥,你前面在<EXCEL和CAD>中发的两个程序都跟你7楼的程序不完全一样,而且第一个执行会出错,你给我修改的哪个是在几楼啊?

meflying · 发表于 2004-7-1 23:22:00

晕，怎么又只贴了一半？？？

;根据起始单元和水平垂直移动单元数目，算出下一单元(vl-load-com)
(defun CalCell(Cell nRow nCol / i n h str sRow sCol sum pos)
(setq sRow nil sCol "" sum 0 h nil pos nil)
(setq i 1)
(repeat (strlen Cell)
(setq str (substr Cell i 1))
(if (/= (type (read str)) 'INT)
(setq sRow (append sRow (list str)))
(setq sCol (strcat sCol str))
)
(setq i (1+ i))
)
(setq sRow (mapcar '(lambda(e) (- (ascii (strcase e)) 64)) sRow))
(setq n (length sRow) i n sum 0)
(repeat n
(setq sum (+ sum (* (nth (1- i) sRow) (expt 26 (- n i)))))
(setq i (1- i))
)
(setq sum (+ sum nCol))
(setq pos nil)
(while (> (setq n (/ sum 26)) 0)
(setq h n)
(setq sum (- sum (* 26 (/ sum 26))))
(setq pos (cons sum pos ))
)
(if h
(setq pos (cons h pos))
(setq pos (cons sum pos ))
)
(strcat (apply 'strcat (mapcar '(lambda(e) (chr (+ e 64))) pos))
(itoa (+ (atoi sCol) nRow)))
);函数(GetRange sheet sCELL nRow)，读取范围，用法：
;参数说明：
;sheet—— excel的sheet对象
;sCELL——起始单元
;eCELL——结束单元
;如：(GetRang sheet "A1" "C10");表示从"A1"到"C10"之间所有范围
(defun GetRange(sheet sCELL eCELL / val items )
(setq val (vlax-get-property sheet 'range sCELL eCELL))
(setq val (vlax-variant-value (vlax-get-property val 'value)))
(if (/= (type val) 'REAL)
(progn
(setq items (vlax-safearray->list val))
(setq items (mapcar '(lambda(e) (mapcar 'vlax-variant-value e)) items))
)
(setq items val)
)
)
(defun MakeText(pt h str / dxf)
(setq dxf (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(100 . "AcDbText")
(cons 10 pt)
(cons 40 h)
(cons 1 str)
(cons 50 (/ pi 2)) '(41 . 1.0) '(51 . 0.0) '(71 . 0)
'(72 . 2) (cons 11 pt) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))
(entmake dxf)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Exl-Open (filename dmode / appsession)
(princ "\n创建一个新的 Excel 电子表格文件...")
(cond
((setq appsession (vlax-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'open filename)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
);IF
);COND1
);COND
appsession
)
(defun Exl-quit (appsession)
(cond
((not (vlax-object-released-p appsession))
(vlax-invoke-method appsession 'QUIT)
(vlax-release-object appsession)
)
)
)
(defun draw(pts)
(command "_.pline")
(mapcar 'command pts)
(command "")
(mapcar '(lambda(e) (if (= (car e) 0)
(command "_.line" (list 0 (+ (cadr e) 10)) '(0 0) "")
(command "_.line" e (list (car e) 0) "")
)
)
pts
)
(command "_.line" (list (- (caar pts) 10) 0) (list (+ (car (last pts)) 10) 0) "")
(mapcar '(lambda(e)
(MakeText (list (car e) (- 2)) 1.25 (rtos (cadr e) 2 4))
(MakeText (list (car e) (- 12)) 1.25 (rtos (car e) 2 4))
)
pts
)
)
(defun main( / filename sheet zin)
(setq zin (getvar "dimzin"))
(setvar "dimzin" 1)
(setq filename (getfiled "打开存放数据的Excel电子表格文档" "e:\\wjh\\study\\autolisp\\nodbird\" "XLS" 8))
(if filename
(progn
(setq appsession (Exl-Open filename "SHOW"))
(setq sheet (vlax-get-property appsession 'ActiveSheet))
(SETQ A (GetRange sheet "B5" "C20"))
(Exl-quit appsession)
(setq a (mapcar '(lambda(e) (if (not (vl-every 'null e)) e)) A))
(setq a (vl-remove nil a))
(draw a)
)
)
(setvar "dimzin" zin)
(princ)
)

;根据起始单元和水平垂直移动单元数目，算出下一单元(vl-load-com)
(defun CalCell(Cell nRow nCol / i n h str sRow sCol sum pos)
   (setq sRow nil sCol "" sum 0 h nil pos nil)
   (setq i 1)   
   (repeat (strlen Cell)
       (setq str (substr Cell i 1))
       (if (/= (type (read str)) 'INT)
           (setq sRow (append sRow (list str)))
           (setq sCol (strcat sCol str))
       )
       (setq i (1+ i))
   )
   (setq sRow (mapcar '(lambda(e) (- (ascii (strcase e)) 64)) sRow))
   (setq n (length sRow) i n sum 0)
   (repeat n
       (setq sum (+ sum (* (nth (1- i) sRow) (expt 26 (- n i)))))
       (setq i (1- i))
   )
   (setq sum (+ sum nCol))
   (setq pos nil)
   (while (> (setq n (/ sum 26)) 0)
       (setq h n)
       (setq sum (- sum (* 26 (/ sum 26))))
       (setq pos (cons sum pos ))
   )
   (if h
       (setq pos (cons h pos))
       (setq pos (cons sum pos ))
   )
   (strcat (apply 'strcat (mapcar '(lambda(e) (chr (+ e 64))) pos))
     (itoa (+ (atoi sCol) nRow)))
);函数(GetRange sheet sCELL nRow)，读取范围，用法：
;参数说明：
;sheet—— excel的sheet对象
;sCELL——起始单元
;eCELL——结束单元
;如：(GetRang sheet "A1" "C10");表示从"A1"到"C10"之间所有范围
(defun GetRange(sheet sCELL eCELL / val items )
   (setq val (vlax-get-property sheet 'range sCELL eCELL))
   (setq val (vlax-variant-value (vlax-get-property val 'value)))
   (if (/= (type val) 'REAL)
       (progn
           (setq items (vlax-safearray->list val))
           (setq items (mapcar '(lambda(e) (mapcar 'vlax-variant-value e)) items))
       )
       (setq items val)
   )
)
(defun MakeText(pt h str / dxf)
   (setq dxf (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(100 . "AcDbText")
       (cons 10 pt)
       (cons 40 h)
       (cons 1 str)
       (cons 50 (/ pi 2)) '(41 . 1.0) '(51 . 0.0) '(71 . 0)
             '(72 . 2) (cons 11 pt) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))
   (entmake dxf)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Exl-Open (filename dmode / appsession)
   (princ "\n创建一个新的 Excel 电子表格文件...")
   (cond
       ((setq appsession (vlax-create-object "Excel.Application"))
         (vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'open filename)
         (if (= (strcase dmode) "SHOW")
             (vla-put-visible appsession 1)
             (vla-put-visible appsession 0)
         );IF
       );COND1
   );COND
   appsession
)
(defun Exl-quit (appsession)
   (cond
       ((not (vlax-object-released-p appsession))
         (vlax-invoke-method appsession 'QUIT)
         (vlax-release-object appsession)
       )
   )
)
(defun draw(pts)
   (command "_.pline")
   (mapcar 'command pts)
   (command "")
   (mapcar '(lambda(e) (if (= (car e) 0)
     (command "_.line" (list 0 (+ (cadr e) 10)) '(0 0) "")
     (command "_.line" e (list (car e) 0) "")
               )
       )
     pts
   )
   (command "_.line" (list (- (caar pts) 10) 0) (list (+ (car (last pts)) 10) 0) "")         
   (mapcar '(lambda(e)
           (MakeText (list (car e) (- 2)) 1.25 (rtos (cadr e) 2 4))
           (MakeText (list (car e) (- 12)) 1.25 (rtos (car e) 2 4))
       )
     pts
   )
)
(defun main( / filename sheet zin)
   (setq zin (getvar "dimzin"))
   (setvar "dimzin" 1)
   (setq filename (getfiled "打开存放数据的Excel电子表格文档" "e:\\wjh\\study\\autolisp\\nodbird\" "XLS" 8))
   (if filename
       (progn
           (setq appsession (Exl-Open filename "SHOW"))
           (setq sheet (vlax-get-property appsession 'ActiveSheet))
           (SETQ A (GetRange sheet "B5" "C20"))
           (Exl-quit appsession)
           (setq a (mapcar '(lambda(e) (if (not (vl-every 'null e)) e)) A))
           (setq a (vl-remove nil a))
           (draw a)
           
       )
   )   
   (setvar "dimzin" zin)
   (princ)
)

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

求助选线,文字问题

本帖子中包含更多资源