2
5
1
初来乍到
本帖以下内容被隐藏保护;需要你回复后,才能看到!
使用道具 举报
6
103
初露锋芒
(defun c:WPL (/ Collector Color Coors Data Dz Elist En First_String Fn Fname I P1 P3 Ptlist Rect Second_String Ss Thick Tmpss) (setq dz (getvar "dimzin")) (setvar "dimzin" 8) (command "_zoom" "_e") (if (setq ss (ssget "_X" (list (cons -4 "") ) ) ) (progn (setq i -1) (repeat (sslength ss) (setq en (ssname ss (setq i (1+ i)))) (setq ptlist (vl-remove-if (function not) (mapcar (function (lambda (x) (if (= 10 (car x)) (list (car (cdr x)) (cadr (cdr x))) ) ) ) (entget en) ) ) ) (setq tmpss (ssget "_CP" ptlist (list (cons -4 "") ) ) ) (if tmpss (while (setq rect (ssname tmpss 0)) (setq collector (cons rect collector)) (ssdel rect tmpss) ) ) ) ) (alert "No boundaries with \nthese properties") ) (command "_zoom" "_p") (foreach itm collector (setq elist (entget itm)) (setq coors (vl-remove-if (function not) (mapcar (function (lambda (x) (if (equal 10 (car x)) (cdr x) ) ) ) elist ) ) ) (setq p1 (car coors) ;;; p2 (cadr coors) p3 (caddr coors) ;;; p4 (cadddr coors) ) (setq thick (cdr (assoc 40 elist)) color (cdr (assoc 62 elist)) ) (setq first_string (strcat "color " (itoa color)) second_string (strcat "_rectang thickness " (rtos thick 2 5) " " (rtos (car p1) 2 2) "," (rtos (cadr p1) 2 2) " " (rtos (car p3) 2 2) "," (rtos (cadr p3) 2 2) ) ) (setq data (cons first_string data) data (cons second_string data)) ) (setq data (reverse data)) (setq fname (strcat (getstring "\nEnter text file name w/o extension to save data: ") ".txt")) (setq fn (open (strcat (getvar "dwgprefix") fname) "w")) (mapcar (function (lambda (x) (write-line x fn))) data ) (close fn) (alert "done") (setvar "dimzin" dz) (princ) ) (princ "\n >> Start command with WPL") (prin1)
本版积分规则 发表回复 回帖后跳转到最后一页
微信公众平台
扫描访问手机版
点击图片下载手机App
|关于我们|小黑屋|乐筑天下 繁体中文
GMT+8, 2025-7-4 21:55 , Processed in 1.242201 second(s), 73 queries .
© 2020-2025 乐筑天下
在线时间:10:00-17:00
暂无
扫一扫,关注我们
帮助中心
关于我们
下载APP客户端