[已解决]申请指定间距排孔程序

pezyl · 发表于 2017-6-3 19:25:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 pezyl 于 2017-6-16 22:07 编辑

看到N版的指定距离间隔批量插点(http://bbs.xdcad.net/thread-706983-1-1.html) 帖子，刚好手头有个类似的工作要做，无奈编程完全不会，特申请编程，谢谢大家。

无标题.png

求个程序

I 需求：曲线给定偏移量，鼠标点选偏移方向，在偏移后的位置

一、指定起点和终点，中间剩余长度按由起点开始按指定间距取点

二、指定起点和终点，中间剩余长度按指定数量均分取点

在起点终点和这些均分或间距点上，1、批量画指定直径大小的单圆或 2、批量画指定直径大小和孔间距的两个圆(两圆连线中点在取点上)。

II 具体步骤：输入命令-----选择曲线或[设置S/设置SS](点选位置离哪头近哪头就为起点)-----鼠标指定偏移方向(相对于曲线)-----完成排孔

在[设置SS]时指定： 1、排列方式(按间距还是均分) 2、偏移量 3、孔径 4、孔间距(为0或直接回车时画单孔) 这些为基本固定不改的参数

在[设置S]时指定： 1、起点 2、终点(为0或直接回车时不需要终点) 3、间距或是均分数量

设置数据能记忆，下次开CAD可以沿用最近一次的设置数据。

III 直线弧线多段线，样条曲线？不知道能不能实现，最好能不改变对象捕捉点。

程序提供4套命令tt1 tt2 tt3 tt4，实现同样的功能，记忆不同的参数数据，这样就不用每次都修改数据。

比较啰嗦了，谢谢各位！

找到个下图的加工孔程序，操作步骤类似我的需求，很是方便，命令是tt1。

Lispboy · 发表于 2017-6-3 22:44:22

本帖最后由 Lispboy 于 2017-6-3 22:46 编辑

1、第二个图，下排的是不是拷贝的第一个图，忘记改了？位置没对上和上边标注那排2、最左边那个单独的一个的，怎么来的？
2、第一个图也不是单圆啊？

如果图不对了，重新更新下图

pezyl · 发表于 2017-6-4 09:49:22

Lispboy 发表于 2017-6-3 22:44

谢谢您，之前的图是有歧义，更新了下图形和说明。书到用时方恨少，惭愧，只好做伸手族了。

longer1000 · 发表于 2017-6-4 13:47:34

支持支持！！！！！

csharp · 发表于 2017-6-4 16:58:10

本帖最后由 csharp 于 2017-6-4 17:40 编辑

大致这样写

(defun c:tt (/ p1 p2 sd ed kw dis r _getdivpts _getpts _mkcir pts)
(defun _getdivpts (p1 p2 sd ed n / an d d1 d0 pts)
(setq an (angle p1 p2)
d (distance p1 p2)
d1 (- d sd ed)
)
(if (> d1 0.0)
(progn
(setq d0 sd
d2 (/ d1 n)
)
(repeat (1+ n)
(setq pts (cons (polar p1 an d0) pts)
d0 (+ d0 d2)
)
)
)
)
pts
)
(defun _getpts (p1 p2 sd ed dis / an d d1 tf pts)
(setq an (angle p1 p2)
d (distance p1 p2)
d1 (- d sd ed)
)
(if (> d1 0.0)
(progn
(setq tf t)
(while tf
(setq pts (cons (polar p1 an sd) pts)
p1 (car pts)
sd dis
)
(if (< (distance p1 p2) dis)
(setq tf nil)
)
)
(cons (polar p2 (+ an pi) ed) pts)
)
)
)
(defun _mkcir (pts r)
(foreach x pts
(entmake (list '(0 . "circle") (cons 10 x) (cons 40 r)))
)
)
(if (not #draw_mode)
(setq #draw_mode "1")
)
(if (not #circle_readius)
(setq #circle_readius 1.0)
)
(if
(and (setq p1 (getpoint "\nFirst Point: "))
(setq p2 (getpoint p1 "\nSecond Point: "))
(if
(setq
sd (getdist
p1
(if #start_dist
(strcat "\nstart dist<" (rtos #start_dist 2 2) ">: ")
"\nstart dist: "
)
)
)
(setq #start_dist sd)
(setq sd #start_dist)
)
sd
(if (setq ed
(getdist p2
(if #end_dist
(strcat "\nend dist<" (rtos #end_dist 2 2) ">: ")
"\nend dist: "
)
)
)
(setq #end_dist ed)
(setq ed #end_dist)
)
ed
)
(progn
(setq r
(getdist p1
(if #circle_readius
(strcat "\n半径<" (rtos #circle_readius 2 2) ">: ")
"\n半径: "
)
)
)
(if r
(setq #circle_readius r)
(setq r #circle_readius)
)
(initget "1 2")
(setq
kw (getkword
(strcat "绘制方式[等分(1)/等距(2)]<" #draw_mode ">: ")
)
)
(if (null kw)
(setq kw "1")
)
(setq #draw_mode kw)
(if (= #draw_mode "1")
(progn
(setq
n (getint
(if #divide_num
(strcat "\n输入等分数量<" (itoa #divide_num) ">: ")
"\n输入等分数量: "
)
)
)
(if n
(setq #divide_num n)
(setq n #divide_num)
)
(if n
(progn
(entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
(if (setq pts (_getdivpts p1 p2 sd ed n))
(_mkcir pts r)
)
)
)
)
(progn
(setq
dis (getdist p1
(if #space_dist
(strcat "\n距离<" (itoa #space_dist) ">: ")
"\n距离: "
)
)
)
(if dis
(setq #divide_num n)
(setq n #divide_num)
)
(if dis
(progn
(entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
(if (setq pts (_getpts p1 p2 sd ed dis))
(_mkcir pts r)
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ p1 p2 sd ed kw dis r _getdivpts _getpts _mkcir pts) 
  (defun _getdivpts (p1 p2 sd ed n / an d d1 d0 pts) 
    (setq an (angle p1 p2) 
          d  (distance p1 p2) 
          d1 (- d sd ed) 
    ) 
    (if        (> d1 0.0) 
      (progn 
        (setq d0 sd 
              d2 (/ d1 n) 
        ) 
        (repeat        (1+ n) 
          (setq        pts (cons (polar p1 an d0) pts) 
                d0  (+ d0 d2) 
          ) 
        ) 
      ) 
    ) 
    pts 
  ) 
  (defun _getpts (p1 p2 sd ed dis / an d d1 tf pts) 
    (setq an (angle p1 p2) 
          d  (distance p1 p2) 
          d1 (- d sd ed) 
    ) 
    (if        (> d1 0.0) 
      (progn 
        (setq tf t) 
        (while tf 
          (setq        pts (cons (polar p1 an sd) pts) 
                p1  (car pts) 
                sd  dis 
          ) 
          (if (< (distance p1 p2) dis) 
            (setq tf nil) 
          ) 
        ) 
        (cons (polar p2 (+ an pi) ed) pts) 
      ) 
    ) 
  ) 
  (defun _mkcir        (pts r) 
    (foreach x pts 
      (entmake (list '(0 . "circle") (cons 10 x) (cons 40 r))) 
    ) 
  ) 
  (if (not #draw_mode) 
    (setq #draw_mode "1") 
  ) 
  (if (not #circle_readius) 
    (setq #circle_readius 1.0) 
  ) 
  (if 
    (and (setq p1 (getpoint "\nFirst Point: ")) 
         (setq p2 (getpoint p1 "\nSecond Point: ")) 
         (if 
           (setq 
             sd        (getdist 
                  p1 
                  (if #start_dist 
                    (strcat "\nstart dist<" (rtos #start_dist 2 2) ">: ") 
                    "\nstart dist: " 
                  ) 
                ) 
           ) 
            (setq #start_dist sd) 
            (setq sd #start_dist) 
         ) 
         sd 
         (if (setq ed 
                    (getdist p2 
                             (if #end_dist 
                               (strcat "\nend dist<" (rtos #end_dist 2 2) ">: ") 
                               "\nend dist: " 
                             ) 
                    ) 
             ) 
           (setq #end_dist ed) 
           (setq ed #end_dist) 
         ) 
         ed 
    ) 
     (progn 
       (setq r 
              (getdist p1 
                       (if #circle_readius 
                         (strcat "\n半径<" (rtos #circle_readius 2 2) ">: ") 
                         "\n半径: " 
                       ) 
              ) 
       ) 
       (if r 
         (setq #circle_readius r) 
         (setq r #circle_readius) 
       ) 
       (initget "1 2") 
       (setq 
         kw (getkword 
              (strcat "绘制方式[等分(1)/等距(2)]<" #draw_mode ">: ") 
            ) 
       ) 
       (if (null kw) 
         (setq kw "1") 
       ) 
       (setq #draw_mode kw) 
       (if (= #draw_mode "1") 
         (progn 
           (setq 
             n (getint 
                 (if #divide_num 
                   (strcat "\n输入等分数量<" (itoa #divide_num) ">: ") 
                   "\n输入等分数量: " 
                 ) 
               ) 
           ) 
           (if n 
             (setq #divide_num n) 
             (setq n #divide_num) 
           ) 
           (if n 
             (progn 
               (entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2))) 
               (if (setq pts (_getdivpts p1 p2 sd ed n)) 
                 (_mkcir pts r) 
               ) 
             ) 
           ) 
         ) 
         (progn 
           (setq 
             dis (getdist p1 
                          (if #space_dist 
                            (strcat "\n距离<" (itoa #space_dist) ">: ") 
                            "\n距离: " 
                          ) 
                 ) 
           ) 
           (if dis 
             (setq #divide_num n) 
             (setq n #divide_num) 
           ) 
           (if dis 
             (progn 
               (entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2))) 
               (if (setq pts (_getpts p1 p2 sd ed dis)) 
                 (_mkcir pts r) 
               ) 
             ) 
           ) 
         ) 
       ) 
     ) 
  ) 
  (princ) 
)

参数太多的时候用界面更方便

(defun c:holes/Form2#OnInitialize (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2#OnInitialize"
"To do"
)
)
(defun c:holes/Form2/PickStartDist#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/PickStartDist#OnClicked"
"To do"
)
)
(defun c:holes/Form2/PickEndDist#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/PickEndDist#OnClicked"
"To do"
)
)
(defun c:holes/Form2/PickRadius#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/PickRadius#OnClicked"
"To do"
)
)
(defun c:holes/Form2/PickCircleDist#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/PickCircleDist#OnClicked"
"To do"
)
)
(defun c:holes/Form2/PickMargin#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/PickMargin#OnClicked"
"To do"
)
)
(defun c:holes/Form2/IsDived#OnClicked (Value /)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/IsDived#OnClicked"
"To do"
)
)
(defun c:holes/Form2/IsOmetry#OnClicked (Value /)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/IsOmetry#OnClicked"
"To do"
)
)
(defun c:holes/Form2/IsSingleCirle#OnClicked (Value /)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/IsSingleCirle#OnClicked"
"To do"
)
)
(defun c:holes/Form2/IsDoubleCirle#OnClicked (Value /)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/IsDoubleCirle#OnClicked"
"To do"
)
)
(defun c:holes/Form2/Draw#OnClicked (/)
(dcl-MessageBox
"To Do: code must be added to event handler\r\nc:holes/Form2/Draw#OnClicked"
"To do"
)
)
(defun c:holedraw (/ str)
(setq str '("YWt6A0hPAAAdeIVCBuKT5SMSaitquYElpJMuyCYuet+kuyxeFheXabt5LT1baJd5I85kM85TEz9W"
"7qwsQGwGv/o65WZta93RWECG//ch70kDv5Z991FApglsOwZOuPYssUfFpecFGEXFFQnJxRsIzaOH"
"kcMNGZigjeUNmKKl9OfFTfYDNHCfRvAcdllvfg7Daladc1SkrvZ4St9vi6b4H4TQ2xSzpv9opBTc"
"k5OK0DtBE3GuxSgKdeuJrQldA0ne6wAR8mAU+CVi6OQiyONAs8oxQ6uU2UnJpjJbokhhX4SlDtJT"
"gBDuw5SXEVUoXbpZx3KC1PprPm8cUcDYIwozHWbbI9IBb/JreoZK0onrQNuKJ9sZ6oA7lzc90WO6"
"bc4FynCI5yrdZbmuP+G9ZtkxQatH8s0qsQQ5y4fErL/+15HWjK00JdSAS9LyiTDS5dIgar2PzFC2"
"lrWVeHPri1M08ozrCIcbqDV8zYUN/4vrI1CLwS6ENdtBKYRh5pMrZX0kipiewGnTkfOhHhPIpQbn"
"yDyiPCYaw8j2nAhk+wAyvHRnAytHiQarX8AxCpoItAZznHarQnbVOouP2RRyQCiEbdtBLISWEnm2"
"Oyc56mDjw6a+4UI+uSuHVTTB2KTBR6VhLwOp0FFjgMWkgUnqZAT9pIHoA0As4L649B67AQykqRNA"
"gxAlDVtVFvCJsZklBNNVtDhBLUgs2MrIpx045d8wOrZCXEqiPUrqORfF44DwvoS4QOnlAhBbCEWi"
"/q2Iqc4AJWMJ6yMgPyUo8dMFxoKjp9Dy4KlEJbGOj4jUwIYrpwfzIwDktcUSYxiD0hwX8azjNJEo"
"JA3LNyPh/c0Zbp3SNNr1zczgZl3jOrBmC5AfXBlgyC9x6RPebpPcM6c7ZufLdc/NUA3iDBdpDIOY"
"04sv0SUVXE2PEc23Ec1fQKRd3OGqknutH9Aw8xvDrHBYgZgAVsgTIbRL3Y0bDPvT6R5g8sjUjTa4"
"lh2UQmKyoPi3kneo8VU4FOug3PCB46xw2EnNINFmpRTpgQsff+ah37BJM6GenEtn4bXNspn+FIHs"
"rAM0cVfThwAxl+kMYhhz5bl1D5P5OxELo3GIroMePv4XN7l5oS7CNcf9iVjGncuQ4EUZaLJRRWbR"
"/kmtIb0ahD3mMiD8SQ2FHkyp8KKEp04iAKiJ76Q5zCsp9KDc51aR3i7a43zvd1z9fe3jmlO5GlUj"
"PFBVFTGMOo0dWqbpdXzsO9ypH2yOeDJ84Ll8Qv8+G21I1AA3/e4oxnbXj/Q6mUj2+o8Wh1waG+OW"
"utI6WuRit1NVhY36ax/dOc/NKetpTlUTNuHrungPMc68BdFrk7QFUvFBrjjFGi5E2+PIMRwCQIfx"
"MMaWjo1hDu2odu3KX5pIUDXugabmNIBd78eGB+5qJprdQ1qk63knmJKqdkPIia0IDOHrv/L2LpUZ"
"OtxE+Wfv0qJ7gvI2nxs6qPaItPZKGUxdrHXp6SBskoWd05fXPLb3Ivs3i3lO1+L+SQtTTtdlPhAD"
"0Zrhg+L2ycGarKvcw9YWtFprHGn09PANv6BtPfs+O2cyVOB15ioScgYtX4l6eWvFni3vCSqOr2Bq"
"k+AznQ6CasSWiEmUsdi7pOM5kqZ47dkOXs3P3ZoYaK8S5OLxYUWYSAiaqCj34AUbNVEHtf3KQz9x"
"lY22kraGUPyy8NJ4Cg4D8wtk5+NVjpgskPlwUHFfyQCKgdASD+T34a83TzwDPsop+qTmt3YLQSJy"
"aJPwIkLOZpyt6FqPlzwZMr2Ona3qnK2FO8WdrQqCLnidLY8lAAJkq0fyMc2ceYOGys6cLVhEdMQV"
"yKCct6cQdDz4TjC/tucSsa8J4uXgtPlHhNkeDCXbgp5TBg3rkQ2Kd4xGnxoNijBNxlkYmKc+KfYI"
"Dy9kI569x2LHihItb5KzeVSGYZ3iKpIpKqpa93B17vTUmtXCnDgOMU6/BSm6RDXRkvRB2jiWWL+B"
"TU7g98tUTGWSGUrsGEqat7C/6NJHIKby+JnU0cfzu7EV2rafA9wjYlD1CZOtqvN5A3hjMR1/GgvD"
"JmBMJuN0/djfhoLbvmFhE8cWKXDbSkOQTOY7bzBpH2hboSn2G/sFAfsmHxsvxgjHFtHn+PgysEq2"
"ZFStUWmBCoC+toqqqzuPAQ2Mwpa/Y1nP46LD9KKEJQFLMvTgTFqkm1fp2IHalgW12qDMc7aVR/kC"
"jeiA4r18B7WL3MPCm8gyBLUPxsObmqpxUWr0ySJ07ZXA/reb2P5JCcJyvLejO4agTKHCW8GAfbY0" "rAg=")
)
(dcl-project-import str)
(dcl-form-show holes/form2)
(princ)
)

(defun c:holes/Form2#OnInitialize (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2#OnInitialize" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/PickStartDist#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/PickStartDist#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/PickEndDist#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/PickEndDist#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/PickRadius#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/PickRadius#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/PickCircleDist#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/PickCircleDist#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/PickMargin#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/PickMargin#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/IsDived#OnClicked (Value /) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/IsDived#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/IsOmetry#OnClicked        (Value /) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/IsOmetry#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/IsSingleCirle#OnClicked (Value /) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/IsSingleCirle#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/IsDoubleCirle#OnClicked (Value /) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/IsDoubleCirle#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holes/Form2/Draw#OnClicked (/) 
  (dcl-MessageBox 
    "To Do: code must be added to event handler\r\nc:holes/Form2/Draw#OnClicked" 
    "To do" 
  ) 
) 
(defun c:holedraw (/ str) 
  (setq        str '("YWt6A0hPAAAdeIVCBuKT5SMSaitquYElpJMuyCYuet+kuyxeFheXabt5LT1baJd5I85kM85TEz9W" 
              "7qwsQGwGv/o65WZta93RWECG//ch70kDv5Z991FApglsOwZOuPYssUfFpecFGEXFFQnJxRsIzaOH" 
              "kcMNGZigjeUNmKKl9OfFTfYDNHCfRvAcdllvfg7Daladc1SkrvZ4St9vi6b4H4TQ2xSzpv9opBTc" 
              "k5OK0DtBE3GuxSgKdeuJrQldA0ne6wAR8mAU+CVi6OQiyONAs8oxQ6uU2UnJpjJbokhhX4SlDtJT" 
              "gBDuw5SXEVUoXbpZx3KC1PprPm8cUcDYIwozHWbbI9IBb/JreoZK0onrQNuKJ9sZ6oA7lzc90WO6" 
              "bc4FynCI5yrdZbmuP+G9ZtkxQatH8s0qsQQ5y4fErL/+15HWjK00JdSAS9LyiTDS5dIgar2PzFC2" 
              "lrWVeHPri1M08ozrCIcbqDV8zYUN/4vrI1CLwS6ENdtBKYRh5pMrZX0kipiewGnTkfOhHhPIpQbn" 
              "yDyiPCYaw8j2nAhk+wAyvHRnAytHiQarX8AxCpoItAZznHarQnbVOouP2RRyQCiEbdtBLISWEnm2" 
              "Oyc56mDjw6a+4UI+uSuHVTTB2KTBR6VhLwOp0FFjgMWkgUnqZAT9pIHoA0As4L649B67AQykqRNA" 
              "gxAlDVtVFvCJsZklBNNVtDhBLUgs2MrIpx045d8wOrZCXEqiPUrqORfF44DwvoS4QOnlAhBbCEWi" 
              "/q2Iqc4AJWMJ6yMgPyUo8dMFxoKjp9Dy4KlEJbGOj4jUwIYrpwfzIwDktcUSYxiD0hwX8azjNJEo" 
              "JA3LNyPh/c0Zbp3SNNr1zczgZl3jOrBmC5AfXBlgyC9x6RPebpPcM6c7ZufLdc/NUA3iDBdpDIOY" 
              "04sv0SUVXE2PEc23Ec1fQKRd3OGqknutH9Aw8xvDrHBYgZgAVsgTIbRL3Y0bDPvT6R5g8sjUjTa4" 
              "lh2UQmKyoPi3kneo8VU4FOug3PCB46xw2EnNINFmpRTpgQsff+ah37BJM6GenEtn4bXNspn+FIHs" 
              "rAM0cVfThwAxl+kMYhhz5bl1D5P5OxELo3GIroMePv4XN7l5oS7CNcf9iVjGncuQ4EUZaLJRRWbR" 
              "/kmtIb0ahD3mMiD8SQ2FHkyp8KKEp04iAKiJ76Q5zCsp9KDc51aR3i7a43zvd1z9fe3jmlO5GlUj" 
              "PFBVFTGMOo0dWqbpdXzsO9ypH2yOeDJ84Ll8Qv8+G21I1AA3/e4oxnbXj/Q6mUj2+o8Wh1waG+OW" 
              "utI6WuRit1NVhY36ax/dOc/NKetpTlUTNuHrungPMc68BdFrk7QFUvFBrjjFGi5E2+PIMRwCQIfx" 
              "MMaWjo1hDu2odu3KX5pIUDXugabmNIBd78eGB+5qJprdQ1qk63knmJKqdkPIia0IDOHrv/L2LpUZ" 
              "OtxE+Wfv0qJ7gvI2nxs6qPaItPZKGUxdrHXp6SBskoWd05fXPLb3Ivs3i3lO1+L+SQtTTtdlPhAD" 
              "0Zrhg+L2ycGarKvcw9YWtFprHGn09PANv6BtPfs+O2cyVOB15ioScgYtX4l6eWvFni3vCSqOr2Bq" 
              "k+AznQ6CasSWiEmUsdi7pOM5kqZ47dkOXs3P3ZoYaK8S5OLxYUWYSAiaqCj34AUbNVEHtf3KQz9x" 
              "lY22kraGUPyy8NJ4Cg4D8wtk5+NVjpgskPlwUHFfyQCKgdASD+T34a83TzwDPsop+qTmt3YLQSJy" 
              "aJPwIkLOZpyt6FqPlzwZMr2Ona3qnK2FO8WdrQqCLnidLY8lAAJkq0fyMc2ceYOGys6cLVhEdMQV" 
              "yKCct6cQdDz4TjC/tucSsa8J4uXgtPlHhNkeDCXbgp5TBg3rkQ2Kd4xGnxoNijBNxlkYmKc+KfYI" 
              "Dy9kI569x2LHihItb5KzeVSGYZ3iKpIpKqpa93B17vTUmtXCnDgOMU6/BSm6RDXRkvRB2jiWWL+B" 
              "TU7g98tUTGWSGUrsGEqat7C/6NJHIKby+JnU0cfzu7EV2rafA9wjYlD1CZOtqvN5A3hjMR1/GgvD" 
              "JmBMJuN0/djfhoLbvmFhE8cWKXDbSkOQTOY7bzBpH2hboSn2G/sFAfsmHxsvxgjHFtHn+PgysEq2" 
              "ZFStUWmBCoC+toqqqzuPAQ2Mwpa/Y1nP46LD9KKEJQFLMvTgTFqkm1fp2IHalgW12qDMc7aVR/kC" 
              "jeiA4r18B7WL3MPCm8gyBLUPxsObmqpxUWr0ySJ07ZXA/reb2P5JCcJyvLejO4agTKHCW8GAfbY0" "rAg=") 
  ) 
  (dcl-project-import str) 
  (dcl-form-show holes/form2) 
  (princ) 
)

pezyl · 发表于 2017-6-4 19:18:09

本帖最后由 pezyl 于 2017-6-5 06:49 编辑

csharp 发表于 2017-6-4 16:58

谢谢您的热心。不过这个对话框文件怎么用我不知道，简单试了上面的代码，没达到我要的效果。

pezyl · 发表于 2017-6-7 16:50:05

csharp 发表于 2017-6-4 16:58

请问您上面的程序和下面的界面怎么结合起来用啊

newer · 发表于 2017-6-8 19:23:35

本帖最后由 newer 于 2017-6-15 12:21 编辑

pezyl 发表于 2017-6-7 16:50

试试

下面代码在 XDRX API 2017.0608+版本执行

(defun c:tt (/ e epa g i key len origin p pa pts pts1 spa ss v1 val x xAxis)
(defun _init ()
(if (not #xd_var_bukong_fs)
(setq #xd_var_bukong_fs "0")
)
(if (not #xd_var_bukong_yuankong)
(setq #xd_var_bukong_yuankong "0")
)
(if (not #xd_var_bukong_start)
(setq #xd_var_bukong_start 50)
)
(if (not #xd_var_bukong_end)
(setq #xd_var_bukong_end 50)
)
(if (not #xd_var_bukong_radius)
(setq #xd_var_bukong_radius 10)
)
(if (not #xd_var_bukong_konggap)
(setq #xd_var_bukong_konggap 50)
)
(if (not #xd_var_bukong_offset)
(setq #xd_var_bukong_offset 30)
)
(if (not #xd_var_bukong_divide)
(setq #xd_var_bukong_divide 3)
)
(if (not #xd_var_bukong_dist)
(setq #xd_var_bukong_dist 500)
)
)
(defun _keyword (key)
(cond
((= key "B")
(if (= #xd_var_bukong_fs "0")
(if (setq val (getreal (xdrx_prompt "\n圆孔距离<"
#xd_var_bukong_dist ">:" t
)
)
)
(setq #xd_var_bukong_dist val)
)
(if (setq val (getint (xdrx_prompt "\n等分数<"
#xd_var_bukong_divide ">:" t
)
)
)
(setq #xd_var_bukong_divide val)
)
)
)
((= key "Y")
(xdrx_initget "0 1")
(if (setq val (getkword (xdrx_prompt "\n圆孔样式[单圆(0)/双圆(1)]<"
(if (= #xd_var_bukong_yuankong
"0"
)
"0"
"1"
) ">:" t
)
)
)
(setq #xd_var_bukong_yuankong val)
)
)
((= key "S")
(if (setq val (getreal (xdrx_prompt "\n起点距离<"
#xd_var_bukong_start ">:" t
)
)
)
(setq #xd_var_bukong_start val)
)
)
((= key "E")
(if (setq val (getreal (xdrx_prompt "\n端点距离<" #xd_var_bukong_end
">:" t
)
)
)
(setq #xd_var_bukong_end val)
)
)
((= key "D")
(if (= #xd_var_bukong_yuankong "1")
(progn
(if (setq val (getreal (xdrx_prompt "\n双孔间距<"
#xd_var_bukong_konggap ">:"
t
)
)
)
(setq #xd_var_bukong_konggap val)
)
)
(princ "\n当前样式是单圆，不能设置孔距.")
)
)
((= key "H")
(if (setq val (getreal (xdrx_prompt "\n圆偏移线距离<"
#xd_var_bukong_offset ">:" t
)
)
)
(setq #xd_var_bukong_offset val)
)
)
((= key "O")
(if (setq val (getreal (xdrx_prompt "\n孔径<" #xd_var_bukong_radius
">:" t
)
)
)
(setq #xd_var_bukong_radius val)
)
)
)
(_prompt)
)
(defun _prompt ()
(xdrx_initget "B Y S E O D H")
(xdrx_prompt "\n当前设置: *分布-按" (if (= #xd_var_bukong_fs "0")
(xdrx_prompt "距离*[/圆孔距离("
#xd_var_bukong_dist
")" t
)
(xdrx_prompt "等分*[等分数(" #xd_var_bukong_divide
")" t
)
) "/圆孔样式[" (if (= #xd_var_bukong_yuankong
"0"
)
"单圆"
"双圆"
) ")/起点距离("
#xd_var_bukong_start ")/终点距离(" #xd_var_bukong_end
")/偏移距离(" #xd_var_bukong_offset ")/孔径("
#xd_var_bukong_radius ")]"
)
)
(defun _initget ()
(if (= #xd_var_bukong_fs "0")
(xdrx_initssget "\n拾取直线[距离(B)/圆孔(Y)/起点(S)/终点(E)/孔径(O)/孔距(D)/偏移(H)]<退出>:"
"B Y S E O D H" "" "_keyword"
)
(xdrx_initssget "\n拾取直线[等分数(B)/圆孔(Y)/起点(S)/终点(E)/孔径(O)/孔距(D)/偏移(H)]<退出>:"
"B Y S E O D H" "" "_keyword"
)
)
)
(defun _getpts (/ i pa p pts)
(setq i 0)
(xdge::entity:make g)
(while (setq p (xdrx_curve_getpointatdist (entlast) (* i #xd_var_bukong_dist)))
(setq pts (cons p pts)
i (1+ i)
)
)
(setq pts (cons (xdrx_curve_getendpoint (entlast)) pts))
(xdrx_entity_delete (entlast))
(reverse pts)
)
(defun _getpoints ()
(setq g (xdge::constructor e)
len (xdge::getpropertyvalue g "length")
spa (xdge::getpropertyvalue g "paramof"
(xdrx_curve_getpointatdist e #xd_var_bukong_start)
)
epa (xdge::getpropertyvalue g "paramof"
(xdrx_curve_getpointatdist e
(- len #xd_var_bukong_end)
)
)
)
(xdge::setpropertyvalue g "setinterval" spa epa)
(if (= #xd_var_bukong_fs "0")
(progn
(setq pts (_getpts))
)
(progn
(setq pts (xdge::getpropertyvalue g "getsamplepoints" (1+ #xd_var_bukong_divide)))
)
)
(xdge::free g)
pts
)
(defun _drawcircle (pts)
(setq origin (car pts)
xAxis (xdrx_vector_normalize (mapcar
'-
(cadr pts)
(car pts)
)
)
)
(setq pts (xdrx_points_offset #xd_var_bukong_offset pts))
(if (= #xd_var_bukong_yuankong "1")
(progn
(setq v1 (xdrx_vector_product xAxis (/ #xd_var_bukong_konggap 2.0)))
(setq pts (apply
'append
(mapcar
'(lambda (x)
(list (mapcar
'+
x
v1
) (mapcar
'-
x
v1
)
)
)
pts
)
)
)
)
)
(xdrx_setmark)
(mapcar
'(lambda (x)
(xdrx_circle_make x #xd_var_bukong_radius)
)
pts
)
(setq ss (xdrx_getss))
(XD::Drag:MirrorByQuadrant "\n移动鼠标确定方向:" ss origin 2 xAxis ""
0.1
)
)
(xdrx_begin)
(_init) (xdrx_initget "0 1")
(if (setq val (getkword (xdrx_prompt "\n输入分布方式[距离(0)/等分(1)]<"
#xd_var_bukong_fs ">:" t
)
)
)
(setq #xd_var_bukong_fs val)
)
(_prompt)
(_initget)
(xdrx_initget "B Y S E O D H")
(if (and
(setq ss (xdrx_ssget ":E:P" '((0 . "LINE"))))
(setq e (ssname ss 0))
)
(progn
(setq pts (_getpoints))
(setq pts1 (_drawcircle pts))
)
)
(xdrx_end)
(princ)
)

(defun c:tt (/ e epa g i key len origin p pa pts pts1 spa ss v1 val x xAxis) 
  (defun _init () 
    (if (not #xd_var_bukong_fs) 
      (setq #xd_var_bukong_fs "0") 
    ) 
    (if (not #xd_var_bukong_yuankong) 
      (setq #xd_var_bukong_yuankong "0") 
    ) 
    (if (not #xd_var_bukong_start) 
      (setq #xd_var_bukong_start 50) 
    ) 
    (if (not #xd_var_bukong_end) 
      (setq #xd_var_bukong_end 50) 
    ) 
    (if (not #xd_var_bukong_radius) 
      (setq #xd_var_bukong_radius 10) 
    ) 
    (if (not #xd_var_bukong_konggap) 
      (setq #xd_var_bukong_konggap 50) 
    ) 
    (if (not #xd_var_bukong_offset) 
      (setq #xd_var_bukong_offset 30) 
    ) 
    (if (not #xd_var_bukong_divide) 
      (setq #xd_var_bukong_divide 3) 
    ) 
    (if (not #xd_var_bukong_dist) 
      (setq #xd_var_bukong_dist 500) 
    ) 
  ) 
  (defun _keyword (key) 
    (cond 
      ((= key "B") 
        (if (= #xd_var_bukong_fs "0") 
          (if (setq val (getreal (xdrx_prompt "\n圆孔距离<" 
                                              #xd_var_bukong_dist ">:" t 
                                 ) 
                        ) 
              ) 
            (setq #xd_var_bukong_dist val) 
          ) 
          (if (setq val (getint (xdrx_prompt "\n等分数<" 
                                             #xd_var_bukong_divide ">:" t 
                                ) 
                        ) 
              ) 
            (setq #xd_var_bukong_divide val) 
          ) 
        ) 
      ) 
      ((= key "Y") 
        (xdrx_initget "0 1") 
        (if (setq val (getkword (xdrx_prompt "\n圆孔样式[单圆(0)/双圆(1)]<" 
                                             (if (= #xd_var_bukong_yuankong 
                                                    "0" 
                                                 ) 
                                               "0" 
                                               "1" 
                                             ) ">:" t 
                                ) 
                      ) 
            ) 
          (setq #xd_var_bukong_yuankong val) 
        ) 
      ) 
      ((= key "S") 
        (if (setq val (getreal (xdrx_prompt "\n起点距离<" 
                                            #xd_var_bukong_start ">:" t 
                               ) 
                      ) 
            ) 
          (setq #xd_var_bukong_start val) 
        ) 
      ) 
      ((= key "E") 
        (if (setq val (getreal (xdrx_prompt "\n端点距离<" #xd_var_bukong_end 
                                            ">:" t 
                               ) 
                      ) 
            ) 
          (setq #xd_var_bukong_end val) 
        ) 
      ) 
      ((= key "D") 
        (if (= #xd_var_bukong_yuankong "1") 
          (progn 
            (if (setq val (getreal (xdrx_prompt "\n双孔间距<" 
                                                #xd_var_bukong_konggap ">:" 
                                                t 
                                   ) 
                          ) 
                ) 
              (setq #xd_var_bukong_konggap val) 
            ) 
          ) 
          (princ "\n当前样式是单圆，不能设置孔距.") 
        ) 
      ) 
      ((= key "H") 
        (if (setq val (getreal (xdrx_prompt "\n圆偏移线距离<" 
                                            #xd_var_bukong_offset ">:" t 
                               ) 
                      ) 
            ) 
          (setq #xd_var_bukong_offset val) 
        ) 
      ) 
      ((= key "O") 
        (if (setq val (getreal (xdrx_prompt "\n孔径<" #xd_var_bukong_radius 
                                            ">:" t 
                               ) 
                      ) 
            ) 
          (setq #xd_var_bukong_radius val) 
        ) 
      ) 
    ) 
    (_prompt) 
  ) 
  (defun _prompt () 
    (xdrx_initget "B Y S E O D H") 
    (xdrx_prompt "\n当前设置: *分布-按" (if (= #xd_var_bukong_fs "0") 
                                          (xdrx_prompt "距离*[/圆孔距离(" 
                                                       #xd_var_bukong_dist 
                                                       ")" t 
                                          ) 
                                          (xdrx_prompt "等分*[等分数(" #xd_var_bukong_divide 
                                                       ")" t 
                                          ) 
                                        ) "/圆孔样式[" (if (= #xd_var_bukong_yuankong 
                                                              "0" 
                                                           ) 
                                                         "单圆" 
                                                         "双圆" 
                                                       ) ")/起点距离(" 
                 #xd_var_bukong_start ")/终点距离(" #xd_var_bukong_end 
                 ")/偏移距离(" #xd_var_bukong_offset ")/孔径(" 
                 #xd_var_bukong_radius ")]" 
    ) 
  ) 
  (defun _initget () 
    (if (= #xd_var_bukong_fs "0") 
      (xdrx_initssget "\n拾取直线[距离(B)/圆孔(Y)/起点(S)/终点(E)/孔径(O)/孔距(D)/偏移(H)]<退出>:" 
                      "B Y S E O D H" "" "_keyword" 
      ) 
      (xdrx_initssget "\n拾取直线[等分数(B)/圆孔(Y)/起点(S)/终点(E)/孔径(O)/孔距(D)/偏移(H)]<退出>:" 
                      "B Y S E O D H" "" "_keyword" 
      ) 
    ) 
  ) 
  (defun _getpts (/ i pa p pts) 
    (setq i 0) 
    (xdge::entity:make g) 
    (while (setq p (xdrx_curve_getpointatdist (entlast) (* i #xd_var_bukong_dist))) 
      (setq pts (cons p pts) 
            i (1+ i) 
      ) 
    ) 
    (setq pts (cons (xdrx_curve_getendpoint (entlast)) pts)) 
    (xdrx_entity_delete (entlast)) 
    (reverse pts) 
  ) 
  (defun _getpoints () 
    (setq g (xdge::constructor e) 
          len (xdge::getpropertyvalue g "length") 
          spa (xdge::getpropertyvalue g "paramof" 
                                      (xdrx_curve_getpointatdist e #xd_var_bukong_start) 
              ) 
          epa (xdge::getpropertyvalue g "paramof" 
                                      (xdrx_curve_getpointatdist e 
                                                                 (- len #xd_var_bukong_end) 
                                      ) 
              ) 
    ) 
    (xdge::setpropertyvalue g "setinterval" spa epa) 
    (if (= #xd_var_bukong_fs "0") 
      (progn 
        (setq pts (_getpts)) 
      ) 
      (progn 
        (setq pts (xdge::getpropertyvalue g "getsamplepoints" (1+ #xd_var_bukong_divide))) 
      ) 
    ) 
    (xdge::free g) 
    pts 
  ) 
  (defun _drawcircle (pts) 
    (setq origin (car pts) 
          xAxis (xdrx_vector_normalize (mapcar 
                                         '- 
                                         (cadr pts) 
                                         (car pts) 
                                       ) 
                ) 
    ) 
    (setq pts (xdrx_points_offset #xd_var_bukong_offset pts)) 
    (if (= #xd_var_bukong_yuankong "1") 
      (progn 
        (setq v1 (xdrx_vector_product xAxis (/ #xd_var_bukong_konggap 2.0))) 
        (setq pts (apply 
                    'append 
                    (mapcar 
                      '(lambda (x) 
                         (list (mapcar 
                                 '+ 
                                 x 
                                 v1 
                               ) (mapcar 
                                   '- 
                                   x 
                                   v1 
                                 ) 
                         ) 
                       ) 
                      pts 
                    ) 
                  ) 
        ) 
      ) 
    ) 
    (xdrx_setmark) 
    (mapcar 
      '(lambda (x) 
         (xdrx_circle_make x #xd_var_bukong_radius) 
       ) 
      pts 
    ) 
    (setq ss (xdrx_getss)) 
    (XD::Drag:MirrorByQuadrant "\n移动鼠标确定方向:" ss origin 2 xAxis "" 
                               0.1 
    ) 
  ) 
  (xdrx_begin) 
  (_init)  (xdrx_initget "0 1") 
  (if (setq val (getkword (xdrx_prompt "\n输入分布方式[距离(0)/等分(1)]<" 
                                       #xd_var_bukong_fs ">:" t 
                          ) 
                ) 
      ) 
    (setq #xd_var_bukong_fs val) 
  ) 
  (_prompt) 
  (_initget) 
  (xdrx_initget "B Y S E O D H") 
  (if (and 
        (setq ss (xdrx_ssget ":E:P" '((0 . "LINE")))) 
        (setq e (ssname ss 0)) 
      ) 
    (progn 
      (setq pts (_getpoints)) 
      (setq pts1 (_drawcircle pts)) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

pezyl · 发表于 2017-6-9 09:06:03

newer 发表于 2017-6-8 19:23

谢谢N版，按您的代码进行到 “拾取直线” 之后没有 “移动鼠标确定方向”的操作提示，但你的GIF演示有。已经装好XDRX API 0608。另外程序能适用各种多段线弧线样条曲线吗？通用性会更好

newer · 发表于 2017-6-9 09:36:53

本帖最后由 newer 于 2017-6-9 09:39 编辑

pezyl 发表于 2017-6-9 09:06

下载最新的XDRX API 2017.0608版本。
你画的直线，确定能被设置的那些长度分割？别是直线太小了

你想适用其他的曲线，把代码里面的 '((0 . "LINE")) 改成 '((0 . "*LINE,ARC"))就行了。

newer · 发表于 2017-6-9 12:26:59

pezyl 发表于 2017-6-9 09:06

你安装了晓东工具箱了吧？旧版的工具箱有个函数和函数库冲突了，你下载下附件，解压缩，拷贝到工具箱的LISP目录覆盖，在重启CAD

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:xdtb_main.rar
下载次数:5 文件大小:600.38 KB
下载权限: 不限以上 [免费赚D豆]

pezyl · 发表于 2017-6-9 14:12:50

newer 发表于 2017-6-9 12:26

确定尺寸足够分格
我一开始没有装晓东工具箱，只装了XDRX API 2017.0608后来我看用不了，又试着装上了晓东工具箱，不过也是一样的问题，把xdtb_main替换掉也没用。

顺便反馈个bug，AutoCAD 2008只装XDRX API会出现了右侧的屏幕菜单，选项里关了之后再新建还是会自动出现，关不掉。

newer · 发表于 2017-6-9 15:37:34

pezyl 发表于 2017-6-9 14:12

在2007,2008都试了，没问题。

API和通用函数库是昨天更新的，2017.06.08，你是刚下载的吗？

你执行完，ZOOM E下，看看圆是不是画别的地方了？不应该。

你执行下下面代码，看是否在屏幕选点处画了个十字虚线？

(defun c:tt1 ()
(if (setq p (getpoint "\n拾取点<退出>:"))
(xd::doc:drawcrosshair (trans p 1 0) 0.0 0.1)
)
(princ)
)

pezyl · 发表于 2017-6-9 15:49:09

newer 发表于 2017-6-9 15:37

是新下载的，6.8号的，而且在同事电脑上的2014也是一样的情况，拾取直线后没有后续操作了

ZOOM E后没有画圆。

执行代码后点选处画有十字虚线。

newer · 发表于 2017-6-9 21:15:39

本帖最后由 newer 于 2017-6-9 21:16 编辑

pezyl 发表于 2017-6-9 15:49

在2010,2016的机器也试了，没问题，

我把代码重新编辑贴了下，你重新拷贝下8楼的代码回去加载，如果还执行不了，就是你那的事了。

布孔-2.gif

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

[已解决] [已解决]申请指定间距排孔程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。