点选多段线自动生成凸台

yu960312 · 发表于 2020-12-10 15:53

有没有大佬会编写这个lisp,点选多段线自动生成凸台

yshf · 发表于 2020-12-11 16:30

yu960312 发表于 2020-12-11 15:55
大神,这两边可不可以改为斜的

(defun c:sctt()
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (command "_undo" "be")
  (If (= (setq A (getreal "\n外移量A<0.2>=")) nil)
   (setq A 0.2)
  )
  (If (= (setq B (getreal "\n边距B<4.0>=")) nil)
   (setq B 4.0)
  )
  (while (and (princ "\n请选取多段线:")
      (setq ssa (ssget ":S" '((0 . "LWPOLYLINE") (90 . 4))))
      )

      (setq tysjb (car (ssnamex ssa)))
      (setq ent (cadr tysjb))
      (setq Obj (vlax-ename->vla-object ent))
      (setq pt (cadr (last tysjb)))
      (setq pa1 (fix (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt))))
      (setq pa2 (1+ pa1))
      (setq pt1 (vlax-curve-getpointatparam ent pa1))
      (setq pt1 (list (car pt1) (cadr pt1)))
      (setq pt2 (vlax-curve-getpointatparam ent pa2))
      (setq pt2 (list (car pt2) (cadr pt2)))
      (setq ang (angle pt1 pt2))
      (setq p1 (polar pt1 ang B))
      (setq p2 (polar p1 (+ ang (* 0.25 pi)) (* A (sqrt 2.0))))
      (setq p4 (polar pt2 ang (- B)))
      (setq p3 (polar p4 (+ ang (* 0.75 pi)) (* A (sqrt 2.0))))
      (setq ptq (member pt1 ptb))
      (setq pth (member pt2 ptb))

      (setq i 0)
      (setq Npts nil)
      (repeat (1+ pa1)
      (setq pt (vlax-curve-getpointatparam ent i))
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
      (setq i (1+ i))
   )
      (mapcar '(lambda(pt)
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
   )
   (list p1 p2 p3 p4)
   )
      (setq i pa2)
      (setq n (1+ (- (fix (vlax-curve-getendparam ent)) pa2)))
      (repeat n
      (setq pt (vlax-curve-getpointatparam ent i))
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
      (setq i (1+ i))
   )
      (setq Npts (reverse Npts))
      (vlax-put obj "Coordinates" Npts)
      (vla-update obj)
  )
  (command "_undo" "e")
  (princ)
)

yshf · 发表于 2020-12-11 09:18

(defun c:sctt()
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (command "_undo" "be")
  (If (= (setq A (getreal "\n外移量A<0.2>=")) nil)
   (setq A 0.2)
  )
  (If (= (setq B (getreal "\n边距B<4.0>=")) nil)
   (setq B 4.0)
  )
  (while (and (princ "\n请选取多段线:")
      (setq ssa (ssget ":S" '((0 . "LWPOLYLINE") (90 . 4))))
      )
      (setq tysjb (car (ssnamex ssa)))
      (setq ent (cadr tysjb))
      (setq Obj (vlax-ename->vla-object ent))
      (setq pt (cadr (last tysjb)))
      (setq pa1 (fix (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt))))
      (setq pa2 (1+ pa1))
      (setq pt1 (vlax-curve-getpointatparam ent pa1))
      (setq pt1 (list (car pt1) (cadr pt1)))
      (setq pt2 (vlax-curve-getpointatparam ent pa2))
      (setq pt2 (list (car pt2) (cadr pt2)))
      (setq ang (angle pt1 pt2))
      (setq p1 (polar pt1 ang B))
      (setq p2 (polar p1 (+ ang (* 0.5 pi)) A))
      (setq p4 (polar pt2 ang (- B)))
      (setq p3 (polar p4 (+ ang (* 0.5 pi)) A))
      (setq ptq (member pt1 ptb))
      (setq pth (member pt2 ptb))
      (setq i 0)
      (setq Npts nil)
      (repeat (1+ pa1)
      (setq pt (vlax-curve-getpointatparam ent i))
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
      (setq i (1+ i))
   )
      (mapcar '(lambda(pt)
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
   )
   (list p1 p2 p3 p4)
   )
      (setq i pa2)
      (setq n (1+ (- (fix (vlax-curve-getendparam ent)) pa2)))
      (repeat n
      (setq pt (vlax-curve-getpointatparam ent i))
      (setq Npts (cons (cadr pt) (cons (car pt) Npts)))
      (setq i (1+ i))
   )
      (setq Npts (reverse Npts))
      (vlax-put obj "Coordinates" Npts)
      (vla-update obj)
  )
  (command "_undo" "e")
  (princ)
)

2496653555 · 发表于 2021-8-25 11:42

(defun c:99 ( / A p1 p2 p3 jl p4 ang)
(command "ucs" "w")
(setq os (getvar "osmode"))
(setvar "osmode" 512)
(princ "\n画凸台,顺时在外,逆时在内")

  (If (= (setq A (getreal "\n外移量A<0.03>=")) nil)
   (setq A 0.03)
)
(setq ss (entsel))

(setq p1 (getpoint"\n输入矩形的一个角点:"))
(setq p3 (getpoint"\n输入矩形的另一个角点:"))
(command "BREAK" ss "f" p1 p3)
(setq jl (distance p1 p3));两点距
(setq ang (angle p1 p3)) ;X轴角度
(setq P2 (polar p1 (- ang (* 0.15 pi)) (* A (sqrt 2.0))))
(setq p4 (polar p3 (- ang (* 0.85 pi)) (* A (sqrt 2.0))))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(62 . 1)
            (cons 90 3) (cons 10 p1) (cons 10 p2) (cons 10 p4) (cons 10 p3))) ;90 线段数

(setq FILLETRAD "0.15")
(command "fillet"(cadr(nentselp p1))(cadr(nentselp p4))
(cadr(nentselp p3))(cadr(nentselp p2)))
(setvar "osmode" os)
jl
);改成了手动点的，后面怎么加上圆角了，一直没弄出来

wzg356 · 发表于 2020-12-10 19:36

用pedit就可以解决的，自己尝试计算插入点，测试即可

前生 · 发表于 2020-12-10 22:21

这个真的会

yu960312 · 发表于 2020-12-11 08:42

前生发表于 2020-12-10 22:21
这个真的会

大哥具体怎么搞

yu960312 · 发表于 2020-12-11 08:44

wzg356 发表于 2020-12-10 19:36
用pedit就可以解决的，自己尝试计算插入点，测试即可

谢谢大哥指引

yu960312 · 发表于 2020-12-11 15:31

yshf 发表于 2020-12-11 09:18
(defun c:sctt()
(vl-load-com)
(setvar "cmdecho" 0)

yu960312 · 发表于 2020-12-11 15:55

yshf 发表于 2020-12-11 09:18
(defun c:sctt()
(vl-load-com)
(setvar "cmdecho" 0)

大神,这两边可不可以改为斜的

2496653555 · 发表于 2021-6-9 20:09

大师，能不能加上控制向内或外了，现在用没有固定

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

[提问] 点选多段线自动生成凸台

本帖子中包含更多资源

本帖子中包含更多资源