如果测量了您的个人资料，这将起作用
线条如上图所示
轮廓必须仅为LWPOLYLINE，否则I
需要重写此lisp代码
文本文件将保存在您工作的同一文件夹中
或者在“文件”对话框中选择所需的其他文件夹
因此，要对块执行相同的操作，我必须
现在没有时间，也许以后
我可以写点什么来解决它
- ;;============================wl.lsp=============================;;
- ;; local defun
- (defun parse-dist (lst / ret)
- (setq ret (mapcar '- (cdr lst)
- (reverse (cdr (reverse lst)))))
- (if (zerop (car lst))
- (setq ret (append (list 0.0) ret))
- )
- ret
- )
- ;; main part
- (defun C:WL (/ axss dist_list dp fn fss obj p1 p2 pc ptlist
- pts sep_list ss txt_file_name txt_list)
- (vl-load-com)
- (prompt "\n >> Select the profile >>")
- (if (setq ss (ssget "_+.:S:E" (list (cons 0 "LWPOLYLINE"))))
- (progn
-
- (setq obj (vlax-ename->vla-object (ssname ss 0)))
- (setq pts (vlax-get obj 'Coordinates))
- (while (cadr pts)
- (setq ptlist (cons (trans (list (car pts)(cadr pts)) 1 0) ptlist))
- (setq pts (cddr pts))
- )
- (setq fss (ssget "F" ptlist (list (cons 0 "LINE"))))
- (setq axss (vla-get-activeselectionset
- (vla-get-activedocument
- (vlax-get-acad-object))))
- (vlax-for a axss
- (setq p1 (vlax-curve-getstartpoint a)
- p2 (vlax-curve-getendpoint a)
- pc (mapcar (function(lambda(a b)(* (+ a b) 0.5))) p1 p2);mid point of line
- dp (vlax-curve-getclosestpointto obj pc)
- dist_list (cons (vlax-curve-getdistatpoint obj dp) dist_list)
- )
- )
- (setq sep_list (parse-dist dist_list))
- (setq txt_list (mapcar 'vl-princ-to-string sep_list))
- (setq txt_file_name (getfiled "Enter file name without extension" (getvar "dwgprefix") "txt" 1))
- (setq fn (open txt_file_name "w"))
- (setq cnt 1)
- (mapcar (function (lambda (x)
- (write-line (strcat (itoa cnt) "," x) fn)
- (setq cnt (1+ cnt)))
- )
- txt_list)
- (close fn)
- )
- )
- (princ)
- )
- ;;============================wl.lsp=============================;;
| 
