新手编的lisp请高手指错误 谢谢

H-浩浩-H

想编写一个给两条直线中间加指定个数及宽度的双线 并平分
可是能力有限      实在搞不定    请大神帮忙   


除第一条直线    和  第二条直线   别的直线都是使用lsp自动生成

请大神帮忙   自己写的代码如下     if  中间的  第一条直线 向 第二条直线 方向偏移线段 不知道怎么写了  而且CAD 提示语法错误


[url=]等分层板ff.LSP[/url]


非常感谢  各位大神的帮助

H-浩浩-H

请高手指点   谢谢

xyp1964

H-浩浩-H 发表于 2016-5-2 07:24
请高手指点   谢谢

H-浩浩-H

xyp1964 发表于 2016-5-2 17:08

谢谢     这个lisp  cad2008 提示   错  误: no function definition: XYP-START     这个怎么解决

ZZXXQQ

2. (defun c:tt()
   
3. (defun dxf (code elist) (cdr (assoc code elist)))
   
4. (vl-load-com)
   
5.   (while(not(setq pt1(entsel "\n\t选择第1条线: "))))
   
6.   (while(not(setq pt2(entsel "\n\t选择第2条线: "))))
   
7.     (setq l1 (entget(car pt1)))
   
8.     (setq l2 (entget(car pt2)))
   
9.         (setq p1 (dxf 10 l1) p2 (dxf 11 l1) p3 (dxf 10 l2) p4 (dxf 11 l2))
   
10.   (setq ang1 (angle p1 p2) ang2 (angle p3 p4))
    
11.   (setq dang (- ang1 ang2))
    
12.   (print dang)
    
13.   (if (or(equal (abs dang) 0 1e-3)(equal (abs dang) pi 1e-3)) (progn
    
14.     (setq a1 (vlax-curve-getclosestpointto (car pt1) '(0 0 0) t))
    
15.     (setq a2 (vlax-curve-getclosestpointto (car pt2) '(0 0 0) t))
    
16.     (setq a3 (abs (- (apply 'max a1) (apply 'max a2))))
    
17.     (print a3)
    
18.     (while(not(setq a4(getdist "\n\t请输入层板厚度 :"))))
    
19.     (while(not(setq a5(getdist "\n\t请输入层板数量 :"))))
    
20.     (setq a6 (/ (- a3 (* a4 a5) (+ a5 1))))
    
21.     (setq a7 1)
    
22.     (if (<= a7 a5) (princ))
    
23.   )
    
24.     (alert "\n两条线不平行不符合条件!")
    
25.   )
    
26.   (princ)
    
27. )

(defun c:tt()<br /> (defun dxf (code elist) (cdr (assoc code elist)))<br /> (vl-load-com)<br />   (while(not(setq pt1(entsel "\n\t选择第1条线: "))))<br />   (while(not(setq pt2(entsel "\n\t选择第2条线: "))))<br />     (setq l1 (entget(car pt1)))<br />     (setq l2 (entget(car pt2)))<br />         (setq p1 (dxf 10 l1) p2 (dxf 11 l1) p3 (dxf 10 l2) p4 (dxf 11 l2))<br />   (setq ang1 (angle p1 p2) ang2 (angle p3 p4))<br />   (setq dang (- ang1 ang2))<br />   (print dang)<br />   (if (or(equal (abs dang) 0 1e-3)(equal (abs dang) pi 1e-3)) (progn<br />     (setq a1 (vlax-curve-getclosestpointto (car pt1) '(0 0 0) t))<br />     (setq a2 (vlax-curve-getclosestpointto (car pt2) '(0 0 0) t))<br />     (setq a3 (abs (- (apply 'max a1) (apply 'max a2))))<br />     (print a3)<br />     (while(not(setq a4(getdist "\n\t请输入层板厚度 :"))))<br />     (while(not(setq a5(getdist "\n\t请输入层板数量 :"))))<br />     (setq a6 (/ (- a3 (* a4 a5) (+ a5 1))))<br />     (setq a7 1)<br />     (if (<= a7 a5) (princ))<br />   )<br />     (alert "\n两条线不平行不符合条件!")<br />   )<br />   (princ)<br /> )

剩下画线功能楼主自编吧

仲文玉

给楼主参考

H-浩浩-H

ZZXXQQ 发表于 2016-5-3 10:30
剩下画线功能楼主自编吧

(defun c:tt()
(defun dxf (code elist) (cdr (assoc code elist)))
(vl-load-com)
  (while(not(setq pt1(entsel "\n\t选择第1条线: "))))
  (while(not(setq pt2(entsel "\n\t选择第2条线: "))))
    (setq l1 (entget(car pt1)))
    (setq l2 (entget(car pt2)))
        (setq p1 (dxf 10 l1) p2 (dxf 11 l1) p3 (dxf 10 l2) p4 (dxf 11 l2))
  (setq ang1 (angle p1 p2) ang2 (angle p3 p4))
  (setq dang (- ang1 ang2))
  (if (or(equal (abs dang) 0 1e-3)(equal (abs dang) pi 1e-3))
   (progn
    (setq a1 (vlax-curve-getclosestpointto (car pt1) '(0 0 0) t))
    (setq a2 (vlax-curve-getclosestpointto (car pt2) '(0 0 0) t))
    (setq a3 (abs (- (apply 'min a1) (apply 'min a2))))
    (print a3)
    (while(not(setq a4(getdist "\n\t请输入层板厚度 :"))))
    (while(not(setq a5(getdist "\n\t请输入层板数量 :"))))
    (setq a6 (/ (- a3 (* a4 a5)) (+ a5 1)))
    (print a6)
    (setq a7 1)
    (setq en(car (pt1)))
    (setq obj(vlax-ename->vla-object en)))
        (setq b1 1)
        (setq b2 0)
    (while (<= a7 a5)
    (vla-Offset obj (+ (* a6 b1) (* a4 b2)))
        (setq b2(+ b2 1))
    (vla-Offset obj (+ (* a6 b1) (* a4 b2)))
        (setq b1(+ b1 1))
        (princ)
        )
   )
    (alert "\n两条线不平行不符合条件!")
  )
  (princ)
)

H-浩浩-H

ZZXXQQ 发表于 2016-5-3 10:30
剩下画线功能楼主自编吧

非常感谢    但是   偏移线的这一块    也有出错提醒   请大侠帮忙看一下哪里有语法错误  谢谢了

feng83

;;未经过严格测试，有问题记得提出来
(defun c:tt()
  (defun dxf (code elist) (cdr (assoc code elist)))
  (vl-load-com)
  (command "ucs" "w")
  (while(not(setq pt1(entsel "\n\t选择第1条线: "))))
  (while(not(setq pt2(entsel "\n\t选择第2条线: "))))
  (setq l1 (entget(car pt1)))
  (setq l2 (entget(car pt2)))
  (setq p1 (dxf 10 l1) p2 (dxf 11 l1) p3 (dxf 10 l2) p4 (dxf 11 l2))
  (setq ang1 (angle p1 p2) ang2 (angle p3 p4))
  (setq dang (- ang1 ang2))
  (print dang)
  (if (or(equal (abs dang) 0 1e-3)(equal (abs dang) pi 1e-3))
    (progn
      (while(not(setq a4(getreal "\n\t请输入层板厚度 :"))))
      (while(not(setq a5(getint "\n\t请输入层板数量 :"))))
      (setq w (angle p1 p3) w1 (angle p2 p4))
      (setq w10 (/ (distance p1 p3) (+ a5 1)) w11 (/ (distance p2 p4) (+ a5 1)))
      (repeat a5
        (setq p10 (polar p1 w w10))
        (setq p11 (polar p2 w1 w11))
        (setq p8 (polar p1 w (- w10 (/ a4 2))))
        (setq p9 (polar p2 w1 (- w11 (/ a4 2))))
        (entmake (list '(0 . "LINE") (cons 10 p8) (cons 11 p9)))
        (setq p15 (polar p1 w (+ w10 (/ a4 2))))
        (setq p16 (polar p2 w1 (+ w11 (/ a4 2))))
        (entmake (list '(0 . "LINE") (cons 10 p15) (cons 11 p16)))
        (setq p1 p10 p2 p11)
      ))
    (alert "\n两条线不平行不符合条件!")
    )
  (princ)
  )

H-浩浩-H

feng83 发表于 2016-5-3 21:40
;;未经过严格测试，有问题记得提出来
(defun c:tt()
  (defun dxf (code elist) (cdr (assoc code  ...

file:///D:/1.png    file:///D:/1.png   非常感谢    我看到有这两个问题    距离没有均分       如果是矩形炸开的线会出现如图的问题