找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 534|回复: 1

[原创]:一个画角平分线的LSP

[复制链接]
发表于 2003-5-17 16:37:20 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
这是我学LSP后写的第三个程序,请高手不要笑话!

  1. ; bisect.lsp
  2. ;平分角,拾取两条线并从其交点绘制平分线延长至第一个拾取点。
  3. ;如果两线平行则中止。

  4. (defun getln (PR)
  5.    (setq TYPE "nil"
  6.    PRMPT (strcat "\n拾取" PR "线: "))
  7.    (while (/= TYPE "LINE")
  8.       (if (/= (setq TEMP (entsel PRMPT)) nil)
  9.          (progn
  10.             (setq LN1 (entget (car TEMP))
  11.             TYPE (cdr (assoc 0 LN1)))
  12.             (if (/= TYPE "LINE")
  13.             (print (strcat "不能截开 " TYPE)))
  14.          )
  15.          (print "Invalid point")
  16.       )
  17.    ) ;end while
  18. ) ;end getln()

  19. (defun C:BISECT(/ P1 P2 P3 P4 PIK1 PIK2 LN1 P5 P6 ANGA ANGB ANGC TEMP TYPE)
  20.    (getln "第一条")
  21.    (setq P1 (cdr (assoc 10 LN1))
  22.       P2 (cdr (assoc 11 LN1))
  23.       PIK1 (osnap (cadr TEMP) "near")
  24.    )
  25.    (getln "第二条")
  26.    (setq p3 (cdr (assoc 10 LN1))
  27.       P4 (cdr (assoc 11 LN1))
  28.       PIK2 (osnap (cadr TEMP) "near")
  29.    )
  30.    ; 取交点和角度
  31.    (setq P5 (inters P1 P2 P3 P4 nil)
  32.       ANGA (angle P5 PIK1)
  33.       ANGB (angle P5 PIK2)
  34.    )
  35.    (if (> ANGA ANGB)
  36.       (setq ANGC (+ (/ (+ (- (* 2 pi) ANGA) ANGB) 2) ANGA))
  37.       (setq ANGC (+ (/ (- ANGB ANGA) 2) ANGA))
  38.    )
  39.    ; 从交点绘制平分线到一定长度
  40.    (command "LINE" P5 (polar P5 ANGC (distance P5 PIK1)) "")      
  41.    (prin1)
  42. ); end bisect.lsp
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-5-19 21:33:05 | 显示全部楼层

Re: [原创]:一个画角平分线的LSP

最初由 bsq 发布
[B]这是我学LSP后写的第三个程序,请高手不要笑话![code]
; bisect.lsp
;平分角,拾取两条线并从其交点绘制平分线延长至第一个拾取点。
;如果两线平行则中止。

(defun getln (PR)
   (setq TYPE "nil"
   PRMP... [/B]

不生气哥哥写的这个很不错哦,在老师的指导下,我也写了个角平分的,我用的是生成直线的方法,呵呵,这段来到论坛真的学到很多东西的。
另外不生气GG你的程序好像有一点小毛病哦,你画两条相交直线然后顺时针两两生线,到最后一个老是到别的方向,不知道是怎么回事,不生气GG帮我指点一下这个程序唠:)

(defun c:jPF ()
  (setq ens (entget(car(entsel "\n选取第一条线:")))
      ens1 (entget(car(entsel "\n选取第二条线:")))
      )
    (if (and ins ens1)
      (progn
      (setq pd (cdr(assoc 0 ens))
            pd1 (cdr(assoc 0 ens1))
            )
      (cond ((/= pd "line") (princ "请选择线!"))
            ((/= pd1 "line") (princ "请选择线!")))
      )
      nil
      )

  (setq  gpt1 (cdr(assoc 10 ens))
         gpt2 (cdr(assoc 11 ens))
         gpt3 (cdr(assoc 10 ens1))
         gpt4 (cdr(assoc 11 ens1))
               )
(setq ang1 (angtos (angle gpt1 gpt2) 0 2)
      ang2 (angtos (angle gpt3 gpt4) 0 2)
      )
(setq ints (inters gpt1 gpt2 gpt3 gpt4 nil)
       angx  (/ (abs(- (atof ang1) (atof ang2))) 2)
       angxl   (rtos(+ (min (atof ang1) (atof ang2)) angx))
       angxll   (polar ints (angtof angxl) 51888)                       ;我要发发发
       angxlll   (polar ints (angtof (rtos(+ (atof angxl) 90))) 591888) ;我就要发发发
      )
       (command ".xline" ints angxll  angxlll "")
  )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-2 16:24 , Processed in 0.390940 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表