乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
楼主: drafter_joe

[编程交流] 增量变量序列

[复制链接]
BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 18:27:38 | 显示全部楼层
由于它们是圆，您知道中心和半径，因此不需要边界框。
 
如果列表中有很多变量，则第二次使用（第n个lst X）而不是cadr等更容易记住第一次是0而不是1
回复

使用道具 举报

drafter_joe

7

主题

39

帖子

32

银币

初来乍到

Rank: 1

铜币
35
发表于 2022-7-5 18:30:17 | 显示全部楼层
你说得对，比格尔，当我思考和研究这个问题时，我得出了相同的结论。我真的很感谢你的提示和建议。让他们来！
回复

使用道具 举报

drafter_joe

7

主题

39

帖子

32

银币

初来乍到

Rank: 1

铜币
35
发表于 2022-7-5 18:35:30 | 显示全部楼层
好吧，它起作用了！但是，我必须说，必须有一种更有效的方法来处理它，代码看起来相当笨拙，有点像“千方百计到达你的肘部”，当然除了李·麦克写的东西。无论如何，这是：
 
  1. ;; Intersections in Set  -  Lee Mac
  2. ;; Returns a list of all points of intersection between all objects in a supplied selection set.
  3. ;; sel - [sel] Selection Set
  5. (defun LM:intersectionsinset2 (sel / id1 id2 ob1 ob2 rtn)
  6.  (repeat (setq id1 (sslength sel))
  7.    (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
  8.    (if        (= (setq ob1type (vla-get-ObjectName ob1)) "AcDbLine")
  9.      (princ)
  10.      (progn
  11. (setq sslist (cons (ssname sel id1) sslist))
  12. (repeat        (setq id2 id1)
  13.   (setq        ob2 (vlax-ename->vla-object
  14.               (ssname sel (setq id2 (1- id2)))
  15.             )
  16.   )
  17.   (if (= (setq ob2type (vla-get-ObjectName ob2)) "AcDbCircle")
  18.     (princ)
  19.     (LM:intersections ob1 ob2 acextendnone)
  20.   )                                ;end if
  21. )                                ;end repeat
  22.      )                                        ;progn
  23.    )                                        ;end if
  24.  )                                        ;end repeat
  25.                                 ;(apply 'append (reverse rtn))  
  26. )

 
  1. ;; Intersections  -  Lee Mac
  2. ;; Returns a list of all points of intersection between two objects
  3. ;; for the given intersection mode.
  4. ;; ob1,ob2 - [vla] VLA-Objects
  5. ;;     mod - [int] acextendoption enum of intersectwith method
  7. (defun LM:intersections        (ob1 ob2 mod / lst rtn int)
  8.  (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
  9.  (repeat (/ (length lst) 3)
  10.    (setq rtn (cons (list (car lst)
  11.                   (cadr lst)
  12.                   (caddr lst)
  13.             )
  14.             rtn
  15.       )
  16.   int (vlax-3d-point lst)
  17.    )
  18.    (vla-ScaleEntity ob1 int newrad)
  19.  )
  20. )

 
  1. ;; Test Program  -  Lee Mac
  2. ;;;(defun c:interset ( / sel )
  3. ;;;    (if (setq sel (ssget))
  4. ;;;        (foreach pnt (LM:intersectionsinset sel)
  5. ;;;            (entmake (list '(0 . "POINT") (cons 10 pnt)))
  6. ;;;        )
  7. ;;;    )
  8. ;;;    (princ)
  9. ;;
  10. ;;;(vl-load-com) (princ)
  11. (defun c:interset (/ sel circen)
  12.  (setvar "cmdecho" 0)
  13.  (setq cc1 (ssget "_X" '((0 . "CIRCLE"))))
  14.  (command "-insert" "*clover chain.dwg" pause 1 "")
  15.  (setq circle (ssname cc1 0))
  16.  (setq rad (cdr (assoc 40 (entget circle))))
  17.  (setq newrad (/ rad 0.5))
  18.  (setq sel (ssget "X" '((0 . "CIRCLE,LINE") (8 . "daisy chain"))))
  19.  (LM:intersectionsinset2 sel)
  20.  (command "._erase" (ssget "X" '((0 . "LINE") (8 . "daisy chain"))) "")
  21.  (setq z 0)
  22.  (setq ss (ssget "X" '((0 . "CIRCLE") (8 . "daisy chain"))))
  23.  (repeat (sslength ss)
  24.    (setq ename (ssname ss z)
  25.   circen (cons (list (cdr (assoc 10 (entget ename)))) circen)
  26.   z (1+ z)
  27.    )    
  28.  )
  29.  (setq circen (reverse circen))
  30.  (setq cpt1 (nth 0 (nth 0 circen)))
  31.  (setq cpt2 (nth 0 (nth 1 circen)))
  32.  (setq cpt3 (nth 0 (nth 2 circen)))
  33.  (setq cpt4 (nth 0 (nth 3 circen)))
  34.  (setq dist (distance cpt1 cpt2))
  35.  (setq stretchdist (/ (- (- dist (* 2 rad)) 1) 2))
  36.  (setq cpt1move (strcat "@" (rtos stretchdist) "," (rtos stretchdist)))
  37.  (setq cpt2move (strcat "@" (rtos (- stretchdist)) "," (rtos stretchdist)))
  38.  (setq cpt3move (strcat "@" (rtos stretchdist) "," (rtos (- stretchdist))))
  39.  (setq cpt4move (strcat "@" (rtos (- stretchdist)) "," (rtos (- stretchdist))))
  40.  (setq atomx (nth 0 cpt1))
  41.  (setq atomy (nth 1 cpt1))
  42.  (setq cpt1x (+ (- rad) atomx))
  43.  (setq cpt1y (+ (- rad) atomy))
  44.  (setq ll (list cpt1x cpt1y))
  45.  (setq cpt1x (+ rad atomx))
  46.  (setq cpt1y (+ rad atomy))
  47.  (setq ur (list cpt1x cpt1y))
  48.  (command "stretch" "C" ll ur "" cpt1 cpt1move)
  49.  (setq atomx (nth 0 cpt2))
  50.  (setq atomy (nth 1 cpt2))
  51.  (setq cpt2x (+ (- rad) atomx))
  52.  (setq cpt2y (+ (- rad) atomy))
  53.  (setq ll (list cpt2x cpt2y))
  54.  (setq cpt2x (+ rad atomx))
  55.  (setq cpt2y (+ rad atomy))
  56.  (setq ur (list cpt2x cpt2y))
  57.  (command "stretch" "C" ll ur "" cpt2 cpt2move)
  58.  (setq atomx (nth 0 cpt3))
  59.  (setq atomy (nth 1 cpt3))
  60.  (setq cpt3x (+ (- rad) atomx))
  61.  (setq cpt3y (+ (- rad) atomy))
  62.  (setq ll (list cpt3x cpt3y))
  63.  (setq cpt3x (+ rad atomx))
  64.  (setq cpt3y (+ rad atomy))
  65.  (setq ur (list cpt3x cpt3y))
  66.  (command "stretch" "C" ll ur "" cpt3 cpt3move)
  67.  (setq atomx (nth 0 cpt4))
  68.  (setq atomy (nth 1 cpt4))
  69.  (setq cpt4x (+ (- rad) atomx))
  70.  (setq cpt4y (+ (- rad) atomy))
  71.  (setq ll (list cpt4x cpt4y))
  72.  (setq cpt4x (+ rad atomx))
  73.  (setq cpt4y (+ rad atomy))
  74.  (setq ur (list cpt4x cpt4y))
  75.  (command "stretch" "C" ll ur "" cpt4 cpt4move)
  76.  (setvar "cmdecho" 1)
  77.  (princ)
  78. )
  79. (vl-load-com)
  80. (princ)

 
我想知道我弯曲、拉伸或干脆打破了多少LISP编码定律？
 
有一件事我改变了我的想法，我要做的是移动这些圆，拉伸奇异地附着在它们上的东西，而不是成对的圆。
 
再次欢迎您的任何想法、想法或评论！
 
起草人Joe
回复

使用道具 举报

12
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-8-19 05:30 , Processed in 2.619972 second(s), 57 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表