如何在直线两段生成小点点

世人皆醉 · 发表于 2022-8-5 16:21:30

mituzhe 发表于 2022-8-5 15:28
其实如果只是想要标记顶点位置。可以单独画点（POINT）图元，可以标记出所有顶点。目前我这个代码，对多段 ...

大佬，你这个打点是往外打的，朝向反了
只能选择一个对象，不能多选
没有删除原来的线，

xj6019 · 发表于 2022-8-5 16:23:29

仅仅适合普通直线的情况，复杂情况不做考虑

(defun c:NM (/ dxf en i p1 p2 p3 p4 s1 ss)
(defun dxf (ent i) (cdr (assoc i (entget ent))))
  (setq i -1)
  (if (setq ss (ssget ":S"(list '(0 . "LINE"))))
(while (and(setq en (ssname ss (setq i (1+ i)))))
(setq p1(dxf en 10)
p2(dxf en 11)
p3(polar p1(angle p1 p2)1)
p4(polar p2(angle p2 p1)1)
)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p3)))
(vla-put-color (vlax-ename->vla-object (entlast)) 2)
(entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 p4)))
(vla-put-color (vlax-ename->vla-object (entlast)) 2)
(entdel en)
)
  )
(princ)
)

mituzhe · 发表于 2022-8-5 16:36:05

本帖最后由 mituzhe 于 2022-8-5 16:40 编辑

世人皆醉发表于 2022-8-5 16:21
大佬，你这个打点是往外打的，朝向反了
只能选择一个对象，不能多选
没有删除原来的线，

我编辑了回答的，能删除原直线，也能多选，只是“:S”关键字，是不用右键确定的选择。我现在改了方向，删除了“:S”关键字，需要右键确认，方便多次选择。

llsheng_73 · 发表于 2022-8-5 16:40:58

本帖最后由 llsheng_73 于 2022-8-5 17:26 编辑

世人皆醉发表于 2022-8-5 13:54
就是个一毫米的线，对的，就是起点是直线的端点，指点是指向另一端

(defun c:tt(/ s p1 p2 d la)
(or(setq d(getreal"短线长度[0.001]"))(setq d 0.001))
(prompt"选择直线")
(if(setq s(ssget'((0 . "line"))))
(while(setq e(ssname s 0))
(setq p1(vlax-curve-getstartpoint e)
p2(vlax-curve-getendpoint e)
la(cdr(assoc 8(entget e))))
(entmakex(mapcar'cons'(0 8 62 10 11)(list"line"la 2 p1(polar p1(angle p1 p2)d))))
(entmakex(mapcar'cons'(0 8 62 10 11)(list"line"la 2 p2(polar p2(angle p2 p1)d))))
(ssdel e s)(entdel e))))
(defun c:tt(/ s p d la)
(or(setq d(getreal"短线长度[0.001]"))(setq d 0.001))
(prompt"选择直线")
(while(setq s(ssget'((0 . "line"))))
(while(setq e(ssname s 0))
(setq en(entget e)la(assoc 8 en)
p(vl-remove'nil(mapcar'(lambda(x)(if(member(car x)'(10 11))(cdr x)))en)))
(entdel e)
(ssdel e s)
(vl-every'(lambda(a)
(entmakex(mapcar'cons'(0 8 62 10 11)(List"line"la 2(car a)(polar(car a)(apply'angle a)d)))))
(list p(reverse p))))))

(defun c:tt(/ s p1 p2 d la) 
  (or(setq d(getreal"短线长度[0.001]"))(setq d 0.001)) 
  (prompt"选择直线") 
  (if(setq s(ssget'((0 . "line")))) 
    (while(setq e(ssname s 0)) 
      (setq p1(vlax-curve-getstartpoint e) 
            p2(vlax-curve-getendpoint e) 
            la(cdr(assoc 8(entget e)))) 
      (entmakex(mapcar'cons'(0 8 62 10 11)(list"line"la 2 p1(polar p1(angle p1 p2)d)))) 
      (entmakex(mapcar'cons'(0 8 62 10 11)(list"line"la 2 p2(polar p2(angle p2 p1)d)))) 
      (ssdel e s)(entdel e)))) 
 
(defun c:tt(/ s p d la) 
  (or(setq d(getreal"短线长度[0.001]"))(setq d 0.001)) 
  (prompt"选择直线") 
  (while(setq s(ssget'((0 . "line")))) 
    (while(setq e(ssname s 0)) 
      (setq en(entget e)la(assoc 8 en) 
            p(vl-remove'nil(mapcar'(lambda(x)(if(member(car x)'(10 11))(cdr x)))en))) 
      (entdel e) 
      (ssdel e s) 
      (vl-every'(lambda(a) 
                  (entmakex(mapcar'cons'(0 8 62 10 11)(List"line"la 2(car a)(polar(car a)(apply'angle a)d))))) 
               (list p(reverse p))))))

mituzhe · 发表于 2022-8-5 16:47:29

llsheng_73 发表于 2022-8-5 16:40

大佬这个简洁，学习了

世人皆醉 · 发表于 2022-8-5 16:49:50

mituzhe 发表于 2022-8-5 16:36
我编辑了回答的，能删除原直线，也能多选，只是“:S”关键字，是不用右键确定的选择。我现在改了方向，删 ...

大佬，你这个删除原直线只是删掉一条，并没有删完啊，比如我选择了5个，5个是都打点了，但是只删了一个原来的直线

mituzhe · 发表于 2022-8-5 16:52:19

世人皆醉发表于 2022-8-5 16:49
大佬，你这个删除原直线只是删掉一条，并没有删完啊，比如我选择了5个，5个是都打点了，但是只删了一个原 ...

我这都删了的。我可以给你截动态图。不过你用楼上大佬的吧，比我的简洁很多

世人皆醉 · 发表于 2022-8-5 17:20:24

llsheng_73 发表于 2022-8-5 16:40

大佬，你这个没有删直线，而且打点不是黄色啊

mituzhe · 发表于 2022-8-5 17:26:39

mituzhe 发表于 2022-8-5 10:49
重新复制了一遍代码，顺便了解了怎么添加代码区域，哈哈

惶恐惶恐，其实 llsheng_73 大佬的更简洁。我掌握的函数少一点，显的有些啰嗦了。

llsheng_73 · 发表于 2022-8-5 17:28:15

世人皆醉发表于 2022-8-5 17:20
大佬，你这个没有删直线，而且打点不是黄色啊

你可能复制的最先发的，最开始确实没注意黄色和删除原来的直线

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

[提问] 如何在直线两段生成小点点

本帖子中包含更多资源

评分

评分