cad抠图 lisp

在进行裁剪时设计了以下程序可以大大提高效率，奉献给大家使用。

1。命令 ： XCC  直接写出spline的长度。用途：直接写出Spline描出的曲线 索 裁剪线 的长度。

源码：

(defun c:xcc (/ ent curve-obj leng)

;统计线长度SPline/Line/ARC适用

(setvar "cmdecho" 0)

(vl-load-com)

( princ

"\n★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ ")

( princ

"\n★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ ")

( princ

"\n★★★★★ (SPline/Line/ARC适用)

李想[email protected] 2010.8.17")

;*****************************

(princ "\n★★★★★请选择SPline/

Line/ ARC 线: ")

(setq ss (ssget)

i 0

l  (sslength

ss)

SumLine 0

)

(while (< i l)

(setq entname

(entget (ssname ss ii))

ent  (ssname ss i)

i

(+ 1

i)

)

;(setq ent (entsel))

(setq curve-obj

(vlax-ename->vla-object  ent

))

(setq LLleng

(vlax-curve-getDistAtParam curve-obj (vlax-curve-getEndParam

curve-obj) ) )

;(princ LLleng)

(setq  SumLine (+ SumLine LLleng )  )

);end (while (< i l)

;*******************************************

(setq TextPoint (getpoint

"\n★★★★★请选择文字插入点:") )

(command "TEXT"

TextPoint  50

""  (rtos

SumLine )  )

(setq

SumLine 0  )

;(princ)

(setvar "cmdecho" 1)

)

2。命令 ：  SSS  将Spline近似延长。理论上SPline是不可延长的，本程序取Spline端部1mm

交点作为方向延长指定长度。用途：裁剪片偏移出放边量后 边角的修整

源码：

;;-----------------------------------------------

;; SPline延长程序：SSS

;; [email protected]

(defun C:sss (/ SSL  ;length of SS

PTS

;returning list

AOBJ1

;Object 1

AOBJ2

;Object 2

N1

;Loop counter

N2

;Loop counter

IPTS

;intersects

A N NN

HOLDOSMODE)

(vl-load-com)

(COMMAND "_.UNDO"

"_GROUP")

(princ

"\n★★★★★Spline近似延长程序 V1.0 ---李想[email protected]")

(setq SPL1_Point1

(getpoint "\n★★★★★请点取Spline 端点:") )

(setq

SPL1_Point1_x (car SPL1_Point1

)  ;返回坐标第1个元素X

SPL1_Point1_y (cadr  SPL1_Point2 )

;返回坐标第2个元素Y

)

(SETQ HOLDOSMODE (GETVAR

"OSMODE"))

(SETVAR "OSMODE" 0)

(setq

SPLine1  ( car

(entsel

"\n★★★★★请选择Spline:"  )

)

)

;(command "erase" SPLine1

"")  ;删除

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(command "arc" "c"

SPL1_Point1  (list

SPL1_Point1_x

(+ 1  SPL1_Point1_y)

0  )  "a"

"359.999")

(setq My_ARC1 (entlast)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;求SPline1

和  My_ARC1 交点: SPL1_Point2

(setq

SPLine1_VLA

(vlax-ename->vla-object  SPLine1 )

;convert to VLA object

My_ARC1_VLA

(vlax-ename->vla-object  My_ARC1 )

;convert to VLA object

;;;寻找交点

IPTS

(vla-intersectwith

SPLine1_VLA

My_ARC1_VLA

0

)

; variant result

IPTS

(vlax-variant-value IPTS)

)

;;;Variant array has

values?

(if (> (vlax-safearray-get-u-bound IPTS 1)

0)

(progn  ;array holds values, convert it

(setq IPTS

;to a list.

(vlax-safearray->list

IPTS)

)

;;;Loop through list constructing points

(while (> (length

IPTS) 0)

(setq PTS  (cons (list (car

IPTS)

(cadr IPTS)

(caddr IPTS)

)

PTS

)

IPTS

(cdddr IPTS)

)

);end while

);end progn

);end if

(setq N 0)

(repeat (length PTS)

(setq A

(ssget "C" (nth N PTS) (nth N PTS)))

(setq

NN 0)

(repeat

(sslength A)

(setq  SPL1_Point2

(nth N PTS)  )

;获得了第二点(圆弧和spline交点:SPL1_Point2 )

(setq NN (1+ NN))

)

(setq N

(1+ N))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;根据  SPL1_Point1  SPL1_Point2 画延长线

; (command "circle"  SPL1_Point2  "1")

(setq  SPL1_Point1_x (car  SPL1_Point1

)  ;返回坐标第1个元素X

SPL1_Point1_y (cadr  SPL1_Point1

)  ;返回坐标第2个元素Y

SPL1_Point2_x (car

SPL1_Point2  )

;返回坐标第1个元素X

SPL1_Point2_y (cadr  SPL1_Point2

)  ;返回坐标第2个元素Y

Jiao_Hudu

(atan  (- SPL1_Point2_y

SPL1_Point1_y )  (- SPL1_Point2_x  SPL1_Point1_x)

)

;Jiao_ang

(angtos  Jiao_Hudu  0 4

)

BuJiao_Hudu

(+ 3.1415926  Jiao_Hudu)

MyLineLength  200

;;定义延长线的长度

)

(command "line"

SPL1_Point1  (list

(+  (* MyLineLength

(cos BuJiao_Hudu)  )

SPL1_Point1_x  )

(+

(* MyLineLength  (sin

BuJiao_Hudu)  )  SPL1_Point1_y

)

0

)

""

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(command "erase" My_ARC1  "")

;删除辅助圆弧

(SETVAR "OSMODE" HOLDOSMODE)

(COMMAND "_.UNDO" "_END")

(PRINC)

)

3。命令 ： CJ  将布置好格栅的裁剪片 按照统一选定的基准方式标注。

a.选定标注水平基准线 b.选择所有竖直格栅线  c.选择所有要标注的Spline  之后可以获得所有Spline基于同一水平基准线的标注basedim

和每条Spline的2端点的特标注作为检验长度。

源码：

;;-----------------------------------------------

;; 裁剪片标注程序,加载后输入cj

(defun C:cj (/ SSL  ;length of SS

PTS

;returning list

AOBJ1

;Object 1

AOBJ2

;Object 2

N1

;Loop counter

N2

;Loop counter

IPTS

;intersects

A N NN

HOLDOSMODE)

(vl-load-com)

(COMMAND "_.UNDO"

"_GROUP")

(SETQ HOLDOSMODE (GETVAR

"OSMODE"))

(SETVAR "OSMODE" 0)

;CAD颜色代码

;红  黄 绿 青 蓝 紫 白

;1 2 3 4 5 6 7

(princ

"\n★★★★★裁剪片格栅批量标注程序V2.2★★★★[email protected]★★2010.8.18★★")

(princ "\n★★★请选择基准线:

")

(setq SS (ssget )

)

(princ "\n★★★请选择格栅线:

")

(setq SSGS (ssget

)

GSi 0

GSl

(sslength SSGS)

)

(while (

;(princ  PTS

)

(setq N 0)

(repeat (- (length PTS) 1)  ;外循环

(setq p1 (nth N PTS)

)

(setq  DPN2  1  )

(

repeat  (-

(- (length PTS) N)  1)

;内循环

(setq  p2 (nth (+ N DPN2) PTS)

p1x (car

p1 )  ;返回坐标第1个元素X

p1y (cadr

p1)  ;返回坐标第2个元素Y

p2x (car

p2 )  ;返回坐标第1个元素X

p2y (cadr

p2 )  ;返回坐标第2个元素Y

)

(if  (= 1

SX  )

;如果是上偏

(progn

(if  ( >

(cadr p1)  (cadr p2) )

(setq

p3 (list  (+ (/ (+(car p1) (car

p2)) 2) D )  (+  (cadr p1)

DY  )  0 )

)

)

(if  (

(cadr p1)  (cadr p2) )

(setq

p3 (list  (+ (/ (+(car p1) (car

p2)) 2) D )  (-  (cadr p2)

DY  )  0 )

)

)

(if  (