重写divide命令

samifox · 发表于 2022-7-5 23:26:18

你好

作为学习的一部分，我尝试重新编写knowen命令，
这次划分

我设法写了这个

(defun C:test        (/ line d x seg i loc)
   (setvar "PDMODE" 34)
   (setq line (entget (car (entsel))))
   (setq d (distance (cdr (assoc 10 line)) (cdr (assoc 11 line))))
   (setq x (getint "how many segments"))
   (setq seg (/ d x))
   (setq i 0)
   (repeat x
   (setq loc (polar (cdr (assoc 10 line)) pi i)) 
     (entmake
(list
  '(0 . "POINT")
  '(100 . "AcDbEntity")
  '(67 . 0)
  '(410 . "Model")
  '(8 . "0")
  '(100 . "AcDbPoint")
   (cons 10 loc))
     )
     (setq i (+ i seg))
   )
 )

问题是我引导极轴的方向，我不知道用户是如何画这条线的，我给了它pi作为常数，但它可以是任何其他角度，我怎么做？

谢谢
谢伊

BIGAL · 发表于 2022-7-5 23:46:27

2.我不会使用保留字“Line”作为变量，这可能会导致问题，例如“Aline”second is（setq ang（angle pt1 pt2））在polar中使用它，它是您的行的正确角度

hmsilva · 发表于 2022-7-5 23:56:56

嗨，Shay，
除了BIGAL已经说过的，我建议在程序中添加一些测试，例如验证要除法的实体类型（“行”）和有效的除法器数。
我还建议不要在enstsel函数中使用entget，因为如果用户选择失败，或按enter键，将向命令行“选择对象：；错误：错误参数类型：lentyp nil”发送错误
由于要分割的实体始终是一条“线”，并且始终是一个开放对象，因此要输入的点数将是输入的线段数减去一。

copy


(defun C:test (/ A B D LIN SEG SEL X)
 (setvar "PDMODE" 34)
 (if (and (setq sel (car (entsel "\nSelect a line to divide <exit>: ")))
      (setq lin (entget sel))
      (eq (cdr (assoc 0 lin)) "LINE")
      (not (initget 6))
      (setq x (getint "\nHow many segments <exit>: "))
     );; and
   (progn
     (setq d (distance    (setq a (cdr (assoc 10 lin)))
           (setq b (cdr (assoc 11 lin)))
         )
     )
     (setq seg (/ d x))
     (repeat (1- x)
   (setq a (polar a (angle a b) seg))
   (entmake
     (list
       '(0 . "POINT")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(100 . "AcDbPoint")
       (cons 10 a)
     )
   );; entmake
     );; repeat
   );; progn
 );; if
 (princ)
);; test

为了不必测试实体类型，更容易强制选择正确的实体类型：

copy


(defun C:test (/ A B D LIN SEG SS X)
 (setvar "PDMODE" 34)
 (if (and (not (prompt "\nSelect a line to divide <exit>: "))
      (setq ss (ssget "_+.:E:S" '((0 . "LINE"))))
      (not (initget 6))
      (setq x (getint "\nHow many segments <exit>: "))
     );; and
   (progn
     (setq lin (entget (ssname ss 0)))
     (setq d (distance    (setq a (cdr (assoc 10 lin)))
           (setq b (cdr (assoc 11 lin)))
         )
     )
     (setq seg (/ d x))
     (repeat (1- x)
   (setq a (polar a (angle a b) seg))
   (entmake
     (list
       '(0 . "POINT")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(100 . "AcDbPoint")
       (cons 10 a)
     )
   );; entmake
     );; repeat
   );; progn
 );; if
 (princ)
);; test

为了发展另一种实体类型，可能是这样的：

copy


(defun C:test (/ A D I OBJ SEG SEL X)
 (vl-load-com)
 (setvar "PDMODE" 34)
 (if (and (not (prompt "\nSelect a line to divide <exit>: "))
      (setq ss (ssget "_+.:E:S" (list (cons 0 "LINE,ARC,*POLYLINE,CIRCLE,SPLINE,ELLIPSE"))))
      (not (initget 6))
      (setq x (getint "\nHow many segments <exit>: "))
     );; and
   (progn
     (setq obj (vlax-ename->vla-object (ssname ss 0)))
     (setq d (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
     (setq seg (/ d x))
     (if (equal (vlax-curve-getstartpoint obj) (vlax-curve-getendpoint obj))
   (setq rep x)
   (setq rep (1- x))
   );; if
     (setq i 0)
     (repeat rep
   (setq a (vlax-curve-getPointAtDist obj (setq i (+ seg i))))
   (entmake
     (list
       '(0 . "POINT")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(100 . "AcDbPoint")
       (cons 10 a)
     )
   );; entmake
     );; repeat
   );; progn
 );; if
 (princ)
);; test

HTH公司
亨里克

David Bethel · 发表于 2022-7-6 00:04:07

我更喜欢这样：

copy


[color=#8b4513];;;ARG => lineEName segQuantity[/color]
[b][color=BLACK]([/color][/b]defun ldivid [b][color=FUCHSIA]([/color][/b]en q / ed p10 p11 d i[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq ed [b][color=NAVY]([/color][/b]entget en[b][color=NAVY])[/color][/b]
      p10 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 10 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      p11 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 11 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        d [b][color=NAVY]([/color][/b]/ [b][color=MAROON]([/color][/b]distance p10 p11[b][color=MAROON])[/color][/b] q[b][color=NAVY])[/color][/b]
        i 1[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]repeat [b][color=NAVY]([/color][/b]1- q[b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"POINT"[/color][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 10 [b][color=BLUE]([/color][/b]polar p10 [b][color=RED]([/color][/b]angle p10 p11[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]* d i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]1+ i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

如果这条线是3D的，那么这里的问题就解决了。代替（极坐标）调用，您必须计算点值。

-大卫

David Bethel · 发表于 2022-7-6 00:17:11

包括3D值；

虽然我确信有mapcar lambda解决方案，但基本想法是将x、y和z增量的百分比添加到起点：

copy


[b][color=BLACK]([/color][/b]defun l3divid [b][color=FUCHSIA]([/color][/b]en q / ed p10 p11 d xd yd zd i pt[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq ed [b][color=NAVY]([/color][/b]entget en[b][color=NAVY])[/color][/b]
      p10 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 10 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      p11 [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 11 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        d [b][color=NAVY]([/color][/b]mapcar '- p11 p10[b][color=NAVY])[/color][/b]
       xd [b][color=NAVY]([/color][/b]* [b][color=MAROON]([/color][/b]car d[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]/ 1. q[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       yd [b][color=NAVY]([/color][/b]* [b][color=MAROON]([/color][/b]cadr d[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]/ 1. q[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       zd [b][color=NAVY]([/color][/b]* [b][color=MAROON]([/color][/b]caddr d[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]/ 1. q[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        i 1[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]repeat [b][color=NAVY]([/color][/b]1- q[b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]setq pt [b][color=MAROON]([/color][/b]mapcar '+ p10 [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]* i xd[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* i yd[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* i zd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"POINT"[/color][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 10 pt[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]1+ i[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-大卫

cwake · 发表于 2022-7-6 00:38:02

希望你不要对所有不同的方法感到困惑。。。这与David的上一个方法类似（不使用polar）。我可以想到另一种使用mapcar lambda的方法。

copy


(defun c:lndiv ( / cnt lin no pt sel )
 (if (and (setq sel (car (entsel "\nSelect a line to divide <exit>: ")))
          (setq lin (entget sel))
          (eq (cdr (assoc 0 lin)) "LINE")
          (not (initget 6))
          (setq no (getint "\nHow many segments <exit>: "))
          )
   ((lambda ( vect )
      (setq cnt 1)
      (repeat (1- no)
        (entmake (list '(0 . "POINT")
                       (cons 10 (mapcar
                                  '(lambda ( a b )
                                     (+ a (* cnt b))
                                     )
                                  pt
                                  vect
                                  )
                             )
                       )
                 )
        (setq cnt (1+ cnt))
        )
      )
     (mapcar
       '(lambda ( a b )
          (/ (- b a) no)
          )
       (setq pt (cdr (assoc 10 lin)))
       (cdr (assoc 11 lin))
       )
     )
   )
 (princ)
 )

[编程交流] 重写divide命令

发表回复

精选推荐

浏览过的版块