我有一个很大的要求！！

Lee Mac · 发表于 2022-7-6 15:08:26

这是意料之中的，因为我不确定这些职位，但我只是想知道是否还有其他需要改变的地方。

Lee Mac · 发表于 2022-7-6 15:09:36

不，除了我们讨论的所有距离的表之外，发布的lisp正是我想要的！我很惊讶你能这么快制作出这些程序！

TheNewGuy · 发表于 2022-7-6 15:15:29

好的，我在这个版本中做了一些更改：

[列表]

所有点都是相对的-无论您在图形中绘制圆的位置，写入文件的点都将相对于各自圆的中心。
[/列表]
[列表]

左下角和右下角点的间距为0.05，与圆的半径无关。
[/列表]
[列表]

相对于较小圆的点作为一条直线写在主要结果下方。
[/列表]

copy


(defun c:cCut  (/ doc spc cEnt root ofile tNum tmp1 tmp2
                 tmp3 tmp4 bsRad cCen cNum cAng i cPt str)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 (setvar "PDMODE" 3)      ; Point Style
 (setvar "PDSIZE" 0.01)  ; Point Size
 (or cut:out (setq cut:out 0.05))
 (or cut:spc (setq cut:spc 0.007))
 (or cut:row (setq cut:row 0.02))
 (or cut:cir (setq cut:cir 0.125))
 (if (and (setq cEnt (car (entsel "\nSelect Base Circle: ")))
          (eq "CIRCLE" (cdr (assoc 0 (entget cEnt)))))
   (progn
     (setq root (strcat (getvar "DWGPREFIX")
                        (substr (getvar "DWGNAME") 1
                                (- (strlen (getvar "DWGNAME")) 4)))
           tNum 0. col 1
           ofile (open (strcat root "_BASE.csv") "w"))
     (write-line "Centre,Top,Right,Left,Bottom Right,Bottom Left" ofile)
     (initget 4)
     (setq tmp1 (getreal (strcat "\nSpecify Spacing from Edge <" (rtos cut:out) "> : ")))
     (or (not tmp1) (setq cut:out tmp1))
     (initget 4)
     (setq tmp2 (getreal (strcat "\nSpecify Circle Spacing <" (rtos cut:spc) "> : ")))
     (or (not tmp2) (setq cut:spc tmp2))
     (initget 4)
     (setq tmp3 (getreal (strcat "\nSpecify Row Spacing <" (rtos cut:row) "> : ")))
     (or (not tmp3) (setq cut:row tmp3))
     (initget 6)
     (setq tmp4 (getreal (strcat "\nSpecify Inner Circle Radius <" (rtos cut:cir) "> : ")))
     (or (not tmp4) (setq cut:cir tmp4))
     (setq bsRad (- (cdr (assoc 40 (entget cEnt))) cut:out cut:cir)
           cCen  (cdr (assoc 10 (entget cEnt))))
     (while (and (not (minusp bsRad))
                 (< cut:cir bsRad))
       (setq cNum (fix (/ (* 2 pi bsRad) (+ (* 2 cut:cir) cut:spc)))
             cAng (/ (* 2 pi) cNum)
             i    0 str "")
       (while (< i cNum)
         (vla-put-color
           (vla-addCircle spc
             (vlax-3D-point
               (setq cPt (polar cCen (* i cAng) bsRad))) cut:cir) col)
         (foreach x (list cPt (polar cPt (/ pi 2) cut:cir)
                              (polar cPt 0  cut:cir)
                              (polar cPt pi cut:cir)
                              (polar (polar cPt 0  0.0396) (/ (* 3 pi) 2) 0.1186)
                              (polar (polar cPt pi 0.0396) (/ (* 3 pi) 2) 0.1186))
           (vla-addPoint spc (vlax-3D-point x))
           (setq str (strcat str (vl-princ-to-string x) (chr 44))))
         (write-line str ofile)
         (setq i (1+ i) tNum (1+ tNum) str ""))
       (setq bsRad (- bsRad (* 2 cut:cir) cut:row) col (abs (- col 3))))
     (princ (strcat "\n<< Number of Circles: " (rtos tNum 2 0) " >>"))
     (close ofile))
   (princ "\n<!> Incorrect Selection <!>"))
 (princ))

Lee Mac · 发表于 2022-7-6 15:18:10

TheNewGuy · 发表于 2022-7-6 15:21:31

Sorry I meant from the center of each arrayed circle to the points on that circle.... does that help?

Lee Mac · 发表于 2022-7-6 15:22:10

Yes, obviously this will be the same for each circle - so I shall include it as a separate line on the bottom of the file.

Anything else that needs raising about the posted LISP above? (#12)

TheNewGuy · 发表于 2022-7-6 15:26:18

I did notice that in the posted lisp the bottom 2 points do not follow the circle when a radius other than .125 is used. They appear to stay in the location that they would be in for a circle with a .125 radius. I am not complaining but I would hate to ask you to redo any of your hard work. Thanks again!

Lee Mac · 发表于 2022-7-6 15:29:26

That is expected, as I wasn't sure of the positions, but I just wondered if there was anything else that needed changing.

TheNewGuy · 发表于 2022-7-6 15:31:34

No, other than the table for all the distances we talked about the posted lisp is exactly what I was wanting! I am amazed how quickly you can produce these programs!

Lee Mac · 发表于 2022-7-6 15:35:24

OK, I have made a few changes in this version:

All points are relative - no matter where you draw your circle in your drawing, the points written to file will be relative to the Center of respective circles.

The Bottom Left, and bottom right points will be spaced at 0.05, irrelevant of the radius of the circle.

The Points relative the smaller circles are written beneath the main results as a one-liner.

copy

(defun c:cCut  (/ doc spc cEnt root ofile tNum tmp1 tmp2 theta                 tmp3 tmp4 bsRad cCen cNum cAng i cPt str) (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))       spc (if (zerop (vla-get-activespace doc))             (if (= (vla-get-mspace doc) :vlax-true)               (vla-get-modelspace doc)               (vla-get-paperspace doc))             (vla-get-modelspace doc))) (setvar "PDMODE" 3)      ; Point Style (setvar "PDSIZE" 0.01)  ; Point Size (or cut:out (setq cut:out 0.05)) (or cut:spc (setq cut:spc 0.007)) (or cut:row (setq cut:row 0.02)) (or cut:cir (setq cut:cir 0.125)) (if (and (setq cEnt (car (entsel "\nSelect Base Circle: ")))          (eq "CIRCLE" (cdr (assoc 0 (entget cEnt)))))   (progn     (setq root (strcat (getvar "DWGPREFIX")                        (substr (getvar "DWGNAME") 1                                (- (strlen (getvar "DWGNAME")) 4)))           tNum 0. col 1           ofile (open (strcat root "_BASE.csv") "w"))     (write-line "Centre,Top,Right,Left,Bottom Right,Bottom Left" ofile)     (initget 4)     (setq tmp1 (getreal (strcat "\nSpecify Spacing from Edge  : ")))     (or (not tmp1) (setq cut:out tmp1))     (initget 4)     (setq tmp2 (getreal (strcat "\nSpecify Circle Spacing  : ")))     (or (not tmp2) (setq cut:spc tmp2))     (initget 4)     (setq tmp3 (getreal (strcat "\nSpecify Row Spacing  : ")))     (or (not tmp3) (setq cut:row tmp3))     (initget 6)     (setq tmp4 (getreal (strcat "\nSpecify Inner Circle Radius  : ")))     (or (not tmp4) (setq cut:cir tmp4))     (setq bsRad (- (cdr (assoc 40 (entget cEnt))) cut:out cut:cir)           cCen  (cdr (assoc 10 (entget cEnt))))     (while (and (not (minusp bsRad))                 (< cut:cir bsRad))       (setq cNum (fix (/ (* 2 pi bsRad) (+ (* 2 cut:cir) cut:spc)))             cAng (/ (* 2 pi) cNum)             i    0 str "")       (while (< i cNum)         (vla-put-color           (vla-addCircle spc             (vlax-3D-point               (setq cPt (polar cCen (* i cAng) bsRad))) cut:cir) col)         (setq theta (atan                       (/ (/ 0.025 cut:cir)                          (sqrt                            (- 1. (expt (/ 0.025 cut:cir) 2))))))         (foreach x (mapcar '(lambda (x) (mapcar '- x cCen))                  (list cPt (polar cPt (/ pi 2) cut:cir)                              (polar cPt 0  cut:cir)                              (polar cPt pi cut:cir)                              (polar cPt (+ (/ (* 3 pi) 2) theta) cut:cir)                              (polar cPt (- (/ (* 3 pi) 2) theta) cut:cir)))           (vla-addPoint spc (vlax-3D-point (mapcar '+ cCen x)))           (setq str (strcat str (vl-princ-to-string x) (chr 44))))         (write-line str ofile)         (setq i (1+ i) tNum (1+ tNum) str ""))       (setq bsRad (- bsRad (* 2 cut:cir) cut:row) col (abs (- col 3))))     (princ (strcat "\n>"))     (write-line "Points Rel. Inner Circle:" ofile)     (write-line (strcat "(0 0 0),(0 " (rtos cut:cir) " 0),("                         (rtos cut:cir) " 0 0),(" (rtos (* -1. cut:cir))                         " 0 0),(" (rtos (* cut:cir (sin theta))) (chr 32)                         (rtos (* -1. cut:cir (cos theta))) " 0),("                         (rtos (* -1. cut:cir (sin theta))) (chr 32)                         (rtos (* -1. cut:cir (cos theta))) " 0)") ofile)                               (close ofile))   (princ "\n Incorrect Selection ")) (princ))

[编程交流] 我有一个很大的要求！！

发表回复

精选推荐