• long8-龙8(中国)唯一官方网站

    CAD > CAD热门问题> CAD常见问题> 文章详情

    CAD中有关lisp程序的绘图技巧

    2019-07-08 8109 CAD绘图技巧大全  

    当我们在使用CAD软件绘制图纸时,经常会因为各种需求,需要了解一些软件的系统程序,对我们使用软件会有帮助的。那龙8CAD中关于lisp程序有哪些绘图技巧呢?今天就为大家简单介绍下。

    CAD中的一些关于lisp程序的绘图技巧:

     1、计算CAD图形中所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)

    (defun c:LL ()

    (setvar "cmdecho" 1)

    (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))

    (setq i 0)

    (setq ll 0)

    (repeat (sslength en)

    (setq ss (ssname en i))

    (setq endata (entget ss))

    (command "lengthen" ss "")

    (setq dd (getvar "perimeter"))

    (setq ll (+ dd ll))

    (setq i (1+ i))

    )

    (princ "所选线条总长为:")(princ ll)(princ)

    )

    2、标注CAD图形中所有线段(加载后只需框选所有线段便可得标注这些线段)

    (defun c:LLL ()

    (COMMAND "UCS" "")

    (setvar "cmdecho" 1)

    (SETVAR "OSMODE" 0)

    (setq ACADObject (vlax-get-aCAD-object)

    ACADDocument (vla-get-ActiveDocument ACADobject)

    mSpace (vla-get-ModelSpace ACADdocument)

    )

    ;;选取需要测量的样条曲线、圆弧、直线、椭圆

    (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))

    (setq i 0)

    ;;获取系统参数textsize

    (setq shh (getvar "textsize"))

    (setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))

    (setq hh (getdist str_hh))

    (while hh

    (setvar "textsize" hh)

    (setq hh nil))

    ;;输入标注文字高度

    ;;循环开始

    (repeat (sslength en)

    (setq ss (ssname en i))

    (setq endata (entget ss))

    (command "lengthen" ss "")

    (setq dd (getvar "perimeter"))

    (princ (strcat "\n长度=" (rtos dd 2)))

    ;;寻找代表图层的字符串

    (setq aa (assoc 0 endata))

    ;;获取图层名称

    (setq aa1 (cdr aa))

    ;;判断线条种类

    (cond

    ((= aa1 "SPLINE")

    ;;如果是spline

    (progn

    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))

    (setq startPnt1 (vla-get-ControlPoints arcObj))

    (setq p1

    (vlax-safearray->list (vlax-variant-value startPnt1))

    )

    (setq x1 (car p1))

    (setq y1 (CADr p1))

    (setq z1 (CADdr p1))

    (setq pp1 (list x1 y1 z1))

    (repeat (- (/ (length p1) 3) 1)

    ;;循环,寻找最后一个控制点

    (setq p1 (cdddr p1))

    (setq x2 (car p1))

    (setq y2 (CADr p1))

    (setq z2 (CADdr p1))

    )

    (setq pp2 (list x2 y2 z2))

    )

    )

    ((= aa1 "LWPOLYLINE")

    ;;如果是LWPOLYLINE

    (progn

    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))

    (setq startPnt1 (vla-get-Coordinates arcObj))

    (setq p1

    (vlax-safearray->list (vlax-variant-value startPnt1))

    )

    (setq x1 (car p1))

    (setq y1 (CADr p1))

    (setq z1 (CADdr p1))

    (setq pp1 (list x1 y1 z1))

    (repeat (- (/ (length p1) 3) 1)

    ;;循环,寻找最后一个控制点

    (setq p1 (cdddr p1))

    (setq x2 (car p1))

    (setq y2 (CADr p1))

    (setq z2 (CADdr p1))

    )

    (setq pp2 (list x2 y2 z2))

    )

    )

    (t

    ;;如果是其他种类线条

    (progn

    (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))

    (setq startPnt1 (vla-get-StartPoint arcObj))

    ;;获取起点

    (setq endPnt1 (vla-get-EndPoint arcObj))

    ;;获取终点

    (setq pp1

    (vlax-safearray->list (vlax-variant-value startPnt1))

    (setq

    pp2 (vlax-safearray->list (vlax-variant-value endPnt1))

    (setq x1 (car pp1))

    (setq y1 (CADr pp1))

    (setq z1 (CADdr pp1))

    (setq x2 (car pp2))

    (setq y2 (CADr pp2))

    (setq z2 (CADdr pp2))

    (setq x (/ (+ x1 x2) 2))

    (setq y (/ (+ y1 y2) 2))

    (setq z (/ (+ z1 z2) 2))

    (setq pt (list x y z))

    ;;取得线段两端的中点

    (setq ang (angle pp1 pp2))

    ;;获取角度

    (if (> (* (/ ang pi) 180) 180)

    (setq ang (+ ang pi))

    (command "text"

    "j"

    "bc"

    pt

    ""

    (* (/ ang pi) 180)

    (strcat "" (rtos dd 2))

    ""

    (setq i (1+ i))

    (prin1)

    (prompt "\n <>在图中直接写出长度")

    (prin1)

    3、连续打断程序

    (defun c:br1 ()

    (command "break" pause "f" pause "@")

    4、将CAD文字导入Excel表格

    (defun c:Q2()

    (setq ffn (getfiled "写出文件" "" "xls" 1))

    (princ "\n选取文字...")

    (setq ss (ssget))

    (setq ff (open ffn "w"))

    (setq i 0)

    (repeat (sslength ss)

    (setq ssn (ssname ss i))

    (setq ssdata (entget ssn))

    (setq sstyp (cdr (assoc 0 ssdata)))

    (if (or (= sstyp "TEXT") (= sstyp "MTEXT"))

    (progn

    (setq txt (cdr (assoc 1 ssdata)))

    (princ txt ff)

    (princ "\n" ff)

    (setq i (1+ i))

    (close ff)

    (princ (strcat "\n写出文件: " ffn))

    (prin1)

    5、删除带颜色图元

    以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次。

    改颜色的LISP程序

    (defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ))

    (defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (princ))

    (defun c:c3()(ssget)(command "chprop" "p" "" "c" "3" "") (princ))

    (defun c:c4()(ssget)(command "chprop" "p" "" "c" "4" "") (princ))

    (defun c:c5()(ssget)(command "chprop" "p" "" "c" "5" "") (princ))

    (defun c:c6()(ssget)(command "chprop" "p" "" "c" "6" "") (princ))

    (defun c:c7()(ssget)(command "chprop" "p" "" "c" "7" "") (princ))

    (defun c:c8()(ssget)(command "chprop" "p" "" "c" "8" "") (princ))

    你用C1 命令就可以将图元改为红色了.其余类似。

    删除红色图元

    (defun C:D1 (/ m A M)

    (setq m:err *error* *error* *merr*)

    (setvar "cmdecho" 0)

    (command "UNDO" "G")

    (prompt "选择图形")

    (setq A (ssget '((62 . 1)) ))

    (if (/= A nil)(progn

    (setq M (sslength A))

    (command "erase" A "")

    (princ "\n共删除红色图元<")(princ M)(princ ">")

    ))

    (command "UNDO" "E")

    (princ) )

    这样,键入 D1 命令,就可以删除红色的图元了。


    以上就是在龙8CAD软件中,当我们在使用CAD软件绘图时,我们可以了解一些软件的程序,可以参考上述内容。今天就介绍这么多了。安装龙8CAD软件试试吧。更多CAD教程技巧,可关注龙8CAD官网进行查看。

    相关文章推荐
    Copyright © 1992-2021 苏州龙8软件股份有限公司 版权所有 苏ICP备12077906号-1 增值电信业务经营许可证: 苏B2-20210241 苏公网安备 32059002004222号
    友情链接: