浩辰CAD中的几个lisp，供参考
本帖最后由 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 (= oldcmd1) (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 (= oldcmd1) (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" angbase90)
)
)
((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
);cond
(setq angle 90.0number 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 (= oldcmd1) (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" angbase90)
)
)
((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
);cond
(setq angle 270.0number 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
);;此段程序已完
样条曲线多段线正好用得上,谢谢 谢谢楼主分享，挺好用的 谢谢分享，学习了 样条曲线多段线正好用得上,谢谢 感謝 lucas_3333 分享程序! 顶楼主，感谢分享 感谢！下载了。 支持！！！！！！！！！！！！
样条曲线多段线正好用得上,谢谢~~
谢谢，下载了。 谢谢分享，下来学习学习！
页:
[1]
2