浩辰CAD中的几个lisp，供参考

lucas_3333 · 发表于 2014-7-1 15:04

本帖最后由 lucas_3333 于 2014-7-1 15:13 编辑

无聊装了浩辰CAD2014版，试了下，不习惯，但是发现appload里加载的竟然有一些源码，这些论坛上已经有了（记忆中是这样）
发出来，有需要的可以参考下

;;====此程序共有四部分内容
;; 一.绘波浪线 ,命令是 PLX
;; 二.绘轴截断 ,命令是 PLZ
;; 三.绘1/4范围波浪线命令是 PLX41
;; 四.绘3/4范围波浪线命令是 PLX43
;;==========================================
;;镜像点函数,mirr-x为X轴镜像,mirr-y为Y轴镜像
;;px--被镜像点,po--镜像基点
(defun mirr-x (px po) (list (car px) (- (* 2 (cadr po)) (cadr px))))
(defun mirr-y (px po) (list (- (* 2 (car po)) (car px)) (cadr px)))
(defun dtr (x) (/ (* x pi) 180));;度至弧度的转换
(defun rtd (x) (/ (* x 180.0) pi))
(defun midpoint (p1 p2) ;;两点的中点函数
(list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0)) )
;;绘制波浪线函数初始化INIT_PLX;;;
(defun init_plx ( / q1)
(command "pline" (setq q1 (getvar "viewctr")) "w" 0 0 q1 ""
"erase" "l" "")
(setq jsq 0)
(princ "******* 初始化成功 *******")
)
;;绘制波浪线函数 PLX1
(defun plx1 (p1 p2 num /
ang5 ang ang0 ang1 ang2 d12 d12mc ;;real
p0 ;;point
num2 num3 n ;;int
)
;;;pg (point)为后用;;;
(if (< num 5) (setq ang5 15.0) (setq ang5 20.0))
(setq ang (angle p1 p2) ;;两点夹角
ang0 (dtr ang5) ;;波浪线角ang5=15 或 20度
ang1 (+ ang ang0) ;;++++
ang2 (- ang ang0) ;;----
d12 (distance p1 p2) ;;两点距离
d12mc (/ d12 num 2.0 (cos ang0));;小段斜线距离
num2 (* num 2) ;;一个波浪线两小段
num3 (1+ num2) ;;总段数
p0 p1
)
(command "pline" p1)
(setq n 1)
(repeat num3 ;;;按段数绘制PLINE;;;
(if (= n num3)
(command p2) ;;;末点归位到第二点(末点)
(if (= n 1) ;;;第一点画法,取D12MC之半;;;
(progn
(command (setq p0 (polar p0 ang1 (/ d12mc 2.0)) pg p0))
;;;(princ "***** ang=") (princ (rtd ang1))
)
(progn
(if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪
(command (setq p0 (polar p0 ang2 d12mc) pg p0))
(command (setq p0 (polar p0 ang1 d12mc)))
);if (= (rem n 2) 0)
);progn
);if n=1
);if n=num3
(setq n (1+ n))
);repeat
(command "")
;(command "pedit" p0 "f" "") ;;曲线拟合
;(princ "请编辑所画的波浪线")
;(command "pedit" "l" "f" "")
);defun plx1
;;==========================
;;绘制波浪线命令 C:PLX
(defun c:plx ( / j
jxm xzm ;;string
q1 q2 pg ;;point
nnn mmm oldos oldblip oldcmd ;;int
)
;;初始化pline命令的线宽为零,即W=0
;;为防止多次运行,设置计数器 JSQ=0 或 NIL;;
(if (= jsq nil) (init_plx) )
(setq mmm 1 q1 '() q2 '())
(setq oldos (getvar "osmode"))
;;存储原图的捕获模式 osmode
;; (if (/= oldos 512) (setvar "osmode" 512))
;;设置 osmode 为 512, 即为捕获最近点
(setq oldblip (getvar "blipmode"))
;;存储原图的点标记符系统变量"+'
(setq oldcmd (getvar "cmdecho"))
;;存储原图的响应回显信息 cmdecho
(if (= oldblip 1) (setvar "blipmode" 0))
;;点标记符系统变量 = 0 时无 "+"
(if (= oldcmd 1) (setvar "cmdecho" 0))
;;回显信息 cmdecho为0,不回显
(setq jxm "Y")
(while (= jxm "Y")
(cond
((= mmm 1) (print) (princ "第一条线..."))
((= mmm 2) (print) (princ "第二条线..."))
((>= mmm 3)(print) (princ "下一条线..."))
)
(princ " 请选择捕捉方式...")
(graphscr)
(setq q1 (getpoint "\n波浪线起点 : "))
(if (= q1 '()) (setq q1 (getvar "viewctr")))
(while (= q2 '())
(setq q2 (getpoint q1 "\n波浪线终点 : ")) )
(setq nnn 8)
(while (or (< nnn 2) (> nnn 7))
(setq nnn (getint "\n波浪线的波段数 (2--7) < 3 > "))
(if (= nnn nil) (setq nnn 3))
);
(PLX1 q1 q2 nnn)
(setq q1 '() q2 '())
(setq mmm (1+ mmm))
(setq jxm (getstring "\n还要画吗 ? (Y/N) < N > "))
; (setq jxm "N")
(setq jxm (strcase jxm))
);while
;;;各系统变量复位;;;;
;; (setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setvar "blipmode" oldblip)
;| (setq xzm (getstring "\n波浪线程序需要卸载吗 ?(Y/N) < Y > "))
(if (= zjm "") (setq xzm "Y"))
(setq xzm (strcase xzm))
(if (= xzm "Y")
(setq c:plz nil @xy nil mirr-x nil mirr-y nil
dtr nil rtd nil midpoint nil init_plx nil
jsq nil plx1 nil c:plx nil)
)|;if end
);defun plx
;;==========================
;;绘制1/4.象限 3/4象限波浪线
;;==========================
(defun h_plx (p1 p2 p0 ang num a_base /
d_a d01 d02 dcp x1 d_d d_r a r ;;real
pbf n ;;int
q00 ;;point
)
(setq d_a (/ ang 1.0 num)
d01 (distance p0 p1)
d02 (distance p0 p2)
dcp (/ (+ d01 d02) 2.0)
x1 (- (car p1) (car p0))
d_d (abs (/ (- d01 d02) num))
)
;; 此组数据不很可靠,请再试DCP-->NN;;
(cond
((and (> dcp 0) (<= dcp 9)) (setq nn 30))
((and (> dcp 9) (<= dcp 20)) (setq nn 40))
((and (> dcp 20) (<= dcp 50)) (setq nn 50))
((and (> dcp 50) (<= dcp 80)) (setq nn 60))
((and (> dcp 80) (<= dcp 120)) (setq nn 70))
((and (> dcp 120)(<= dcp 300)) (setq nn 80))
(T (setq nn 90))
)
(setq d_r (/ dcp nn))
(if (>= d01 d02) (setq pbf -1) (setq pbf 1))
(command "pline" p1)
(setq n 1)
(while (<= (* n d_a) ang) ;;;按段数绘制PLINE;;;
(if (>= (* n d_a) ang)
(command p2) ;;;末点归位到第二点(末点)
(if (= n 1) ;;;第一点画法,取D12MC之半;;;
(progn
(setq r (+ d01 (* n d_d pbf) d_r)
a (+ a_base (/ d_a 2.0)) )
(command (polar p0 (dtr a) r))
)
(progn
(if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪
(progn
(setq r (+ (+ d01 (* (- n 1) d_d pbf)) d_r)
a (+ a_base (* (- n 1) d_a) (/ d_a 2.0)) )
(command (setq q00 (polar p0 (dtr a) r)))
)
(progn
(setq r (- (+ d01 (* (1- n) d_d pbf)) d_r)
a (+ a_base (* (1- n) d_a) (/ d_a 2.0)) )
(command (setq q00 (polar p0 (dtr a) r)))
)
);if (= (rem n 2) 0)
);progn
);if n=1
);if n=num3
(setq n (1+ n))
);while
(command "")
(command "pedit" "l" "f" "") ;;曲线拟合
);defun plx1
;;绘制1/4.象限 3/4象限波浪线
(defun c:plx41 ( / r
oldos oldblip oldcmd lx ;;int
q1 q2 q0 ;;point
x1 x2 y1 y2 r ;;real
angle number angbase
d_xx ;;string
)
(if (= jsq nil) (init_plx) )
(setq oldos (getvar "osmode"))
;;存储原图的扑捉模式 osmode
(if (/= oldos 512) (setvar "osmode" 512))
;;设置 osmode 为 512, 即为捕获最近点
(setq oldblip (getvar "blipmode"))
;;存储原图的点标记符系统变量"+'
(if (= oldblip 1) (setvar "blipmode" 0))
;;点标记符系统变量 = 0 时无 "+"
(setq oldcmd (getvar "cmdecho"))
;;存储原图的响应回显信息 cmdecho
(if (= oldcmd 1) (setvar "cmdecho" 0))
;;回显信息 cmdecho为0,不回显
(princ " 如果想用捕获方式,请选择方式,现在默认最近点...")
(setq q1 '() q2 '())
(while (= q1 '())
(setq q1 (getpoint "\n在轴的母线选另一点 : ")) )
(while (= q2 '())
(setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))
(setq x1 (car q1) y1 (cadr q1)
x2 (car q2) y2 (cadr q2))
(if (or (= x1 x2) (= y1 y2)) (setq q2 '()))
)
;;变量D_XX为第几相限(1 2 3 4)的选定
(cond
((> x1 x2)
(if (> y1 y2)
(setq q0 (list x2 y1) d_xx "4" angbase 270)
(setq q0 (list x2 y1) d_xx "1" angbase 0)
)
)
((< x1 x2)
(if (> y1 y2)
(setq q0 (list x2 y1) d_xx "3" angbase 180)
(setq q0 (list x2 y1) d_xx "2" angbase 90)
)
)
((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
);cond
(setq angle 90.0 number 15)
(cond
((= d_xx "1") (H_PLX q1 q2 q0 angle number 0))
((= d_xx "2") (H_PLX q2 q1 q0 angle number 90))
((= d_xx "3") (H_PLX q1 q2 q0 angle number 180))
((= d_xx "4") (H_PLX q2 q1 q0 angle number 270))
);cond
);;此段程序未完
(defun c:plx43 ( / r
oldos oldblip oldcmd lx ;;int
q1 q2 q0 ;;point
x1 x2 y1 y2 r ;;real
angle number angbase
d_xx ;;string
)
(if (= jsq nil) (init_plx) )
(setq oldos (getvar "osmode"))
;;存储原图的扑捉模式 osmode
(if (/= oldos 512) (setvar "osmode" 512))
;;设置 osmode 为 512, 即为捕获最近点
(setq oldblip (getvar "blipmode"))
;;存储原图的点标记符系统变量"+'
(if (= oldblip 1) (setvar "blipmode" 0))
;;点标记符系统变量 = 0 时无 "+"
(setq oldcmd (getvar "cmdecho"))
;;存储原图的响应回显信息 cmdecho
(if (= oldcmd 1) (setvar "cmdecho" 0))
;;回显信息 cmdecho为0,不回显
(princ " 如果想用捕获方式,请选择方式,现在默认最近点...")
(setq q1 '() q2 '())
(while (= q1 '())
(setq q1 (getpoint "\n在轴的母线选另一点 : ")) )
(while (= q2 '())
(setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))
(setq x1 (car q1) y1 (cadr q1)
x2 (car q2) y2 (cadr q2))
(if (or (= x1 x2) (= y1 y2)) (setq q2 '()))
)
(cond
((> x1 x2)
(if (> y1 y2)
(setq q0 (list x2 y1) d_xx "4" angbase 270)
(setq q0 (list x2 y1) d_xx "1" angbase 0)
)
)
((< x1 x2)
(if (> y1 y2)
(setq q0 (list x2 y1) d_xx "3" angbase 180)
(setq q0 (list x2 y1) d_xx "2" angbase 90)
)
)
((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
);cond
(setq angle 270.0 number 27)
(cond
((= d_xx "1") (H_PLX q2 q1 q0 angle number 90))
((= d_xx "2") (H_PLX q1 q2 q0 angle number 180))
((= d_xx "3") (H_PLX q2 q1 q0 angle number 270))
((= d_xx "4") (H_PLX q1 q2 q0 angle number 0))
);cond
);;此段程序已完

;;====此程序共有四部分内容 
;; 一.绘波浪线 ,命令是 PLX 
;; 二.绘轴截断 ,命令是 PLZ 
;; 三.绘1/4范围波浪线 命令是 PLX41 
;; 四.绘3/4范围波浪线 命令是 PLX43 
;;========================================== 
;;镜像点函数,mirr-x为X轴镜像,mirr-y为Y轴镜像 
;;px--被镜像点,po--镜像基点 
(defun mirr-x (px po) (list (car px) (- (* 2 (cadr po)) (cadr px)))) 
(defun mirr-y (px po) (list (- (* 2 (car po)) (car px)) (cadr px))) 
(defun dtr (x) (/ (* x pi) 180));;度至弧度的转换 
(defun rtd (x) (/ (* x 180.0) pi)) 
(defun midpoint (p1 p2)         ;;两点的中点函数 
   (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0)) ) 
;;绘制波浪线函数初始化INIT_PLX;;; 
(defun init_plx ( / q1)   
  (command "pline" (setq q1 (getvar "viewctr")) "w" 0 0 q1 "" 
           "erase" "l" "") 
  (setq jsq 0) 
  (princ "******* 初始化成功 *******") 
) 
;;绘制波浪线函数 PLX1 
(defun plx1 (p1 p2 num / 
             ang5 ang ang0 ang1 ang2 d12 d12mc ;;real 
             p0                                ;;point 
             num2 num3 n                       ;;int 
            ) 
            ;;;pg (point)为后用;;; 
   (if (< num 5) (setq ang5 15.0) (setq ang5 20.0)) 
   (setq ang (angle p1 p2)     ;;两点夹角 
         ang0 (dtr ang5)       ;;波浪线角ang5=15 或 20度 
         ang1 (+ ang ang0)     ;;++++ 
         ang2 (- ang ang0)     ;;---- 
         d12 (distance p1 p2)  ;;两点距离 
         d12mc (/ d12 num 2.0 (cos ang0));;小段斜线距离 
         num2 (* num 2)        ;;一个波浪线两小段 
         num3 (1+ num2)        ;;总段数 
         p0 p1 
   )       
   (command "pline" p1) 
   (setq n 1) 
   (repeat num3         ;;;按段数绘制PLINE;;; 
     (if (= n num3)       
      (command p2)      ;;;末点归位到第二点(末点) 
      (if (= n 1)       ;;;第一点画法,取D12MC之半;;; 
        (progn   
          (command (setq p0 (polar p0 ang1 (/ d12mc 2.0)) pg p0)) 
          ;;;(princ "***** ang=") (princ (rtd ang1)) 
        ) 
        (progn 
         (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪 
          (command (setq p0 (polar p0 ang2 d12mc) pg p0)) 
          (command (setq p0 (polar p0 ang1 d12mc))) 
         );if (= (rem n 2) 0) 
        );progn 
      );if n=1 
     );if n=num3 
     (setq n (1+ n)) 
   );repeat 
   (command "") 
   ;(command "pedit" p0 "f" "")  ;;曲线拟合 
   ;(princ "请编辑所画的波浪线") 
    ;(command "pedit" "l" "f" "") 
);defun plx1 
;;========================== 
;;绘制波浪线命令 C:PLX 
(defun c:plx ( / j 
              jxm xzm                       ;;string 
              q1 q2 pg                      ;;point 
              nnn mmm oldos oldblip oldcmd  ;;int 
             ) 
   ;;初始化pline命令的线宽为零,即W=0 
   ;;为防止多次运行,设置计数器 JSQ=0 或 NIL;; 
   (if (= jsq nil) (init_plx) ) 
   (setq mmm 1 q1 '() q2 '()) 
   (setq oldos (getvar "osmode")) 
                 ;;存储原图的捕获模式 osmode 
;;   (if (/= oldos 512) (setvar "osmode" 512)) 
                 ;;设置 osmode 为 512, 即为捕获最近点 
   (setq oldblip (getvar "blipmode")) 
                 ;;存储原图的点标记符系统变量"+' 
   (setq oldcmd (getvar "cmdecho")) 
                 ;;存储原图的响应回显信息 cmdecho 
   (if (= oldblip 1) (setvar "blipmode" 0)) 
       ;;点标记符系统变量 = 0 时 无 "+" 
   (if (= oldcmd  1) (setvar "cmdecho" 0)) 
                 ;;回显信息 cmdecho为0,不回显 
   (setq jxm "Y") 
   (while (= jxm "Y") 
    (cond 
      ((= mmm 1) (print) (princ "第一条线...")) 
      ((= mmm 2) (print) (princ "第二条线...")) 
      ((>= mmm 3)(print) (princ "下一条线...")) 
    ) 
    (princ " 请选择捕捉方式...") 
    (graphscr) 
    (setq q1 (getpoint "\n波浪线起点 : ")) 
    (if (= q1 '()) (setq q1 (getvar "viewctr"))) 
    (while (= q2 '())   
      (setq q2 (getpoint q1 "\n波浪线终点 : ")) ) 
    (setq nnn 8) 
    (while (or (< nnn 2) (> nnn 7)) 
      (setq nnn (getint "\n波浪线的波段数 (2--7) < 3 > ")) 
      (if (= nnn nil) (setq nnn 3)) 
    ); 
    (PLX1 q1 q2 nnn) 
    (setq q1 '() q2 '()) 
    (setq mmm (1+ mmm)) 
    (setq jxm (getstring "\n还要画吗 ? (Y/N) < N > ")) 
;    (setq jxm "N") 
    (setq jxm (strcase jxm)) 
  );while 
  ;;;各系统变量复位;;;; 
;;  (setvar "osmode" oldos) 
  (setvar "cmdecho" oldcmd) 
  (setvar "blipmode" oldblip) 
 ;|   (setq xzm (getstring "\n波浪线程序需要卸载吗 ?(Y/N) < Y > ")) 
    (if (= zjm "") (setq xzm "Y")) 
    (setq xzm (strcase xzm)) 
    (if (= xzm "Y") 
        (setq c:plz nil @xy nil mirr-x nil mirr-y nil 
              dtr nil rtd nil midpoint nil init_plx nil 
              jsq nil plx1 nil c:plx nil) 
    )|;if end 
 
);defun plx 
 
;;========================== 
;;绘制1/4.象限 3/4象限波浪线 
;;========================== 
(defun h_plx (p1 p2 p0 ang num a_base / 
              d_a d01 d02 dcp x1 d_d d_r a r ;;real 
              pbf n                          ;;int 
              q00                            ;;point 
             ) 
   (setq d_a (/ ang 1.0 num) 
         d01 (distance p0 p1) 
         d02 (distance p0 p2) 
         dcp (/ (+ d01 d02) 2.0) 
         x1  (- (car p1) (car p0)) 
         d_d (abs (/ (- d01 d02) num)) 
   ) 
   ;; 此组数据不很可靠,请再试DCP-->NN;; 
   (cond 
     ((and (> dcp 0)  (<= dcp 9))   (setq nn 30)) 
     ((and (> dcp 9)  (<= dcp 20))  (setq nn 40)) 
     ((and (> dcp 20) (<= dcp 50))  (setq nn 50)) 
     ((and (> dcp 50) (<= dcp 80))  (setq nn 60)) 
     ((and (> dcp 80) (<= dcp 120)) (setq nn 70)) 
     ((and (> dcp 120)(<= dcp 300)) (setq nn 80)) 
     (T                             (setq nn 90)) 
   )   
   (setq d_r (/ dcp nn)) 
   (if (>= d01 d02) (setq pbf -1) (setq pbf 1)) 
   (command "pline" p1) 
   (setq n 1) 
   (while (<= (* n d_a) ang)     ;;;按段数绘制PLINE;;; 
     (if (>= (* n d_a) ang) 
      (command p2)      ;;;末点归位到第二点(末点) 
      (if (= n 1)       ;;;第一点画法,取D12MC之半;;; 
        (progn    
           (setq r (+ d01 (* n d_d pbf) d_r) 
                 a (+ a_base (/ d_a 2.0)) ) 
           (command (polar p0 (dtr a) r)) 
        ) 
        (progn 
         (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪 
          (progn 
            (setq r (+ (+ d01 (* (- n 1) d_d pbf)) d_r) 
                  a (+ a_base (* (- n 1) d_a) (/ d_a 2.0)) ) 
            (command (setq q00 (polar p0 (dtr a) r))) 
          )   
          (progn 
            (setq r (- (+ d01 (* (1- n) d_d pbf)) d_r) 
                  a (+ a_base (* (1- n) d_a) (/ d_a 2.0)) ) 
            (command (setq q00 (polar p0 (dtr a) r))) 
          ) 
         );if (= (rem n 2) 0) 
        );progn 
      );if n=1 
     );if n=num3 
     (setq n (1+ n)) 
   );while 
   (command "") 
   (command "pedit" "l" "f" "")  ;;曲线拟合 
);defun plx1 
;;绘制1/4.象限 3/4象限波浪线 
(defun c:plx41 ( / r 
       oldos oldblip oldcmd lx     ;;int 
       q1 q2 q0                    ;;point 
       x1 x2 y1 y2 r               ;;real 
       angle number angbase 
       d_xx                        ;;string 
               ) 
    (if (= jsq nil) (init_plx) ) 
    (setq oldos (getvar "osmode")) 
                  ;;存储原图的扑捉模式 osmode 
    (if (/= oldos 512) (setvar "osmode" 512)) 
                 ;;设置 osmode 为 512, 即为捕获最近点 
    (setq oldblip (getvar "blipmode")) 
                 ;;存储原图的点标记符系统变量"+' 
    (if (= oldblip 1) (setvar "blipmode" 0)) 
                 ;;点标记符系统变量 = 0 时 无 "+" 
    (setq oldcmd (getvar "cmdecho")) 
                 ;;存储原图的响应回显信息 cmdecho 
    (if (= oldcmd  1) (setvar "cmdecho" 0)) 
                 ;;回显信息 cmdecho为0,不回显 
    (princ " 如果想用捕获方式,请选择方式,现在默认最近点...") 
    (setq q1 '() q2 '()) 
    (while (= q1 '())   
      (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) ) 
    (while (= q2 '())   
      (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : ")) 
      (setq x1 (car q1) y1 (cadr q1) 
            x2 (car q2) y2 (cadr q2)) 
      (if (or (= x1 x2) (= y1 y2)) (setq q2 '())) 
    ) 
    ;;变量D_XX为第几相限(1 2 3 4)的选定 
    (cond 
      ((> x1 x2) 
         (if (> y1 y2) 
             (setq q0 (list x2 y1) d_xx "4" angbase 270) 
             (setq q0 (list x2 y1) d_xx "1" angbase   0) 
         ) 
      ) 
      ((< x1 x2) 
         (if (> y1 y2) 
             (setq q0 (list x2 y1) d_xx "3" angbase 180) 
             (setq q0 (list x2 y1) d_xx "2" angbase  90) 
         ) 
      ) 
      ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! ")) 
    );cond 
    (setq angle 90.0  number 15) 
    (cond 
      ((= d_xx "1") (H_PLX q1 q2 q0 angle number 0)) 
      ((= d_xx "2") (H_PLX q2 q1 q0 angle number 90)) 
      ((= d_xx "3") (H_PLX q1 q2 q0 angle number 180)) 
      ((= d_xx "4") (H_PLX q2 q1 q0 angle number 270)) 
    );cond 
);;此段程序未完 
(defun c:plx43 ( / r 
       oldos oldblip oldcmd lx     ;;int 
       q1 q2 q0                    ;;point 
       x1 x2 y1 y2 r               ;;real 
       angle number angbase 
       d_xx                        ;;string 
               ) 
    (if (= jsq nil) (init_plx) ) 
    (setq oldos (getvar "osmode")) 
                  ;;存储原图的扑捉模式 osmode 
    (if (/= oldos 512) (setvar "osmode" 512)) 
                 ;;设置 osmode 为 512, 即为捕获最近点 
    (setq oldblip (getvar "blipmode")) 
                 ;;存储原图的点标记符系统变量"+' 
    (if (= oldblip 1) (setvar "blipmode" 0)) 
                 ;;点标记符系统变量 = 0 时 无 "+" 
    (setq oldcmd (getvar "cmdecho")) 
                 ;;存储原图的响应回显信息 cmdecho 
    (if (= oldcmd  1) (setvar "cmdecho" 0)) 
                 ;;回显信息 cmdecho为0,不回显 
    (princ " 如果想用捕获方式,请选择方式,现在默认最近点...") 
    (setq q1 '() q2 '()) 
    (while (= q1 '())   
      (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) ) 
    (while (= q2 '())   
      (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : ")) 
      (setq x1 (car q1) y1 (cadr q1) 
            x2 (car q2) y2 (cadr q2)) 
      (if (or (= x1 x2) (= y1 y2)) (setq q2 '())) 
    ) 
    (cond 
      ((> x1 x2) 
         (if (> y1 y2) 
             (setq q0 (list x2 y1) d_xx "4" angbase 270) 
             (setq q0 (list x2 y1) d_xx "1" angbase   0) 
         ) 
      ) 
      ((< x1 x2) 
         (if (> y1 y2) 
             (setq q0 (list x2 y1) d_xx "3" angbase 180) 
             (setq q0 (list x2 y1) d_xx "2" angbase  90) 
         ) 
      ) 
      ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! ")) 
    );cond 
    (setq angle 270.0  number 27) 
    (cond 
      ((= d_xx "1") (H_PLX q2 q1 q0 angle number 90)) 
      ((= d_xx "2") (H_PLX q1 q2 q0 angle number 180)) 
      ((= d_xx "3") (H_PLX q2 q1 q0 angle number 270)) 
      ((= d_xx "4") (H_PLX q1 q2 q0 angle number 0)) 
    );cond 
);;此段程序已完

yubihai · 发表于 2019-11-6 07:55

样条曲线多段线正好用得上,谢谢

sunny_8848 · 发表于 2019-11-6 08:51

谢谢楼主分享，挺好用的

happy336 · 发表于 2019-10-30 00:15

谢谢分享，学习了

ymcui · 发表于 2014-7-1 16:01

样条曲线多段线正好用得上,谢谢

yoyoho · 发表于 2014-7-1 18:50

感謝 lucas_3333 分享程序!

小师傅 · 发表于 2014-7-1 20:16

顶楼主，感谢分享

434939575 · 发表于 2014-7-1 21:38

感谢！下载了。

spp_wall · 发表于 2014-7-2 08:17

支持！！！！！！！！！！！！

tangjunasd58 · 发表于 2014-7-3 08:30

alexmai · 发表于 2014-7-5 11:43

样条曲线多段线正好用得上,谢谢~~

陈亚娣 · 发表于 2014-7-5 11:44

谢谢，下载了。

yshf · 发表于 2014-7-7 07:56

谢谢分享，下来学习学习！

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

[源码] 浩辰CAD中的几个lisp，供参考

本帖子中包含更多资源

点评

浏览过的版块