已改好一个dcl，求把圆形桩全部用块替换的程序

ambox

以上是修改的DCL窗口，以及未修改的lsp原来程序，

希望达到的要求是图片中所示

把所有的circle圆形的桩用系统已有的块替换

xyp1964

2. ;; 伪源码需要e派工具箱(XCAD)的支持(defun c:tt (/ ilst ll1 ll2)
   
3.   (cmdla0)
   
4.   (defun main-pro (/ ss i s1 pt)
   
5.     (defun aaa (pt wide c-mode / ww)
   
6.       (setq ww (* wide 0.5))
   
7.       (if c-mode
   
8.         (xyp-circle pt ww)
   
9.         (xyp-rectang
   
10.           (xyp-Pt2XY pt (- ww) (- ww))
    
11.           (xyp-Pt2XY pt ww ww)
    
12.         )
    
13.       )
    
14.     )
    
15.     (princ "\n选择圆形或方形桩: ")
    
16.     (setq ss (ssget '((0 . "circle,*polyline"))))
    
17.     (setq i -1)
    
18.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
19.       (setq pt (xyp-9pt s1 5))
    
20.       (cond ((= po1 "0") (aaa pt 500 t))
    
21.             ((= po1 "1") (aaa pt 600 t))
    
22.             ((= po1 "2") (aaa pt 700 t))
    
23.             ((= po1 "3") (aaa pt 800 t))
    
24.             ((= po1 "4") (aaa pt 400 nil))
    
25.             ((= po1 "5") (aaa pt 500 nil))
    
26.             ((= po1 "6") (aaa pt 600 nil))
    
27.             ((= po1 "7") (aaa pt 700 nil))
    
28.             ((= po1 "8") (aaa pt 800 nil))
    
29.       )
    
30.     )
    
31.     (xyp-erase ss)
    
32.   )
    
33.   (xyp-initSet '(po1) '("0"))
    
34.   (setq        lst1 '("500圆桩" "600圆桩" "700圆桩" "800圆桩" "400方桩" "500方桩" "600方桩" "700方桩" "800方桩")
    
35.         ilst '(("po1" "类型" "list" "lst1" "12" "12"))
    
36.   )
    
37.   (if (= (xyp-Dcl-Init Ilst "【桩替换】" t) 1)
    
38.     (main-pro)
    
39.   )
    
40.   (cmdla1)
    
41. )

;; 伪源码需要e派工具箱(XCAD)的支持(defun c:tt (/ ilst ll1 ll2)<br />   (cmdla0)<br />   (defun main-pro (/ ss i s1 pt)<br />     (defun aaa (pt wide c-mode / ww)<br />       (setq ww (* wide 0.5))<br />       (if c-mode<br />         (xyp-circle pt ww)<br />         (xyp-rectang<br />           (xyp-Pt2XY pt (- ww) (- ww))<br />           (xyp-Pt2XY pt ww ww)<br />         )<br />       )<br />     )<br />     (princ "\n选择圆形或方形桩: ")<br />     (setq ss (ssget '((0 . "circle,*polyline"))))<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq pt (xyp-9pt s1 5))<br />       (cond ((= po1 "0") (aaa pt 500 t))<br />             ((= po1 "1") (aaa pt 600 t))<br />             ((= po1 "2") (aaa pt 700 t))<br />             ((= po1 "3") (aaa pt 800 t))<br />             ((= po1 "4") (aaa pt 400 nil))<br />             ((= po1 "5") (aaa pt 500 nil))<br />             ((= po1 "6") (aaa pt 600 nil))<br />             ((= po1 "7") (aaa pt 700 nil))<br />             ((= po1 "8") (aaa pt 800 nil))<br />       )<br />     )<br />     (xyp-erase ss)<br />   )<br />   (xyp-initSet '(po1) '("0"))<br />   (setq        lst1 '("500圆桩" "600圆桩" "700圆桩" "800圆桩" "400方桩" "500方桩" "600方桩" "700方桩" "800方桩")<br />         ilst '(("po1" "类型" "list" "lst1" "12" "12"))<br />   )<br />   (if (= (xyp-Dcl-Init Ilst "【桩替换】" t) 1)<br />     (main-pro)<br />   )<br />   (cmdla1)<br /> )

zh.

果断顶起.....

chleiwu

这个要是能实现，布桩真的很方便
希望高手出手

NetBee

实现上来讲是不难的，关键是通用
我的工具箱主要针对设计提供的图纸，进行转换后方便检查重叠，编号，提取坐标。
http://nbtools.5d6d.net/thread-139-1-1.html

给个思路：1、根据条件使用ssget获取选择集
2、循环提取圆心坐标
3、根据圆心坐标创建块

ambox

希望高手出手

ambox

希望高手出手

yjynma

帮老大顶……。希望高手出手……

hao3ren

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=93936

ambox

再顶顶再顶顶再顶顶