2013-05-21 QQ群：ALISP＆VLISP(143438137) 聊天记录：说说怎么画，想要什么

CCarch

也许沧桑(1436511711)于2013-05-21 11-42-07：
n -1
        zdjsc nil )
  (repeat aa
    (setq pts1(nth (setq n(1+ n)) cddj)
          pts2(nth (+ n 1) cddj)
          ljj1(nth  n ljj)
          )
    (setq ljc(ljsc ljj1 pts1 pts2)
          zdjsc(append zdjsc (list ljc));交点集
          )
    )
  ;计算下端肋距实长
  (setq aa(length ljj)
        n -1
        xdjsc nil )
  (repeat aa
    (setq pts1(nth (setq n(1+ n)) xplist)
          pts2(nth (+ n 1) xplist)
          ljj1(nth  n ljj)
          )
    (setq ljc(ljsc ljj1 pts1 pts2)
          xdjsc(append xdjsc (list ljc));交点集
          )
    )
  ;计算肋骨冲势、旋转角
  (setq pt11(nth zjlg splist)
        pt12(nth zjlg xplist)
        pt13(nth zjlg cddj)
        pt14(nth (- zjlg 1) cddj)
        pt15(nth (+ zjlg 1) cddj)
        )
  (command "line" pt11 pt12 "" )
  (setq pl11(entlast))
  (SETQ N 0)
  (COMMAND "PLINE" (CAR cddj))
  (REPEAT (LENGTH cddj)
    (COMMAND (NTH (SETQ N (1+ N)) cddj))
    )
  (COMMAND "")
  (COMMAND "pedit" (entlast) "f" f "")
  (setq pl12(entlast))
  (setq pt16(car (test pl11 pl12)))
  (entdel pl12)
  (if (> (abs (- (angle pt13 pt16) (angle pt13 pt14))) 0.8)
    (progn
      (setq pl13(ssname lgx (+ zjlg 1)))
      (setq lj1(nth zjlg ljj))
      (setq pt14a pt15)
      )
    (progn
      (setq pl13(ssname lgx (- zjlg 1)))
      (setq lj1(nth (- zjlg 1) ljj))
      (setq pt14a pt14)
      )
    )
  (setq cc1(vlax-curve-getClosestPointTo (vlax-ename->vla-object pl11) pt13))
  (if (= (distance pt13 cc1) 0.0)
    (command "xline" (polar pt13 pi 500) cc1 "")
    (command "xline" pt13  cc1 "")
    )
  (setq pl14(entlast))
  (setq pt17(car (test pl13 pl14)))
  (setq as1(lgsc pl13 pt14a pt17))
  (setq ss1(ljsc lj1 pt13 pt17))
  (setq ss2(ljsc lj1 pt13 pt14a))
  (setq pas(/ (- (+ (* ss1 ss1) (* ss2 ss2)) (* as1 as1)) (* (* 2 ss1) ss2)))
  (setq pad(sqrt(- 1 (* pas pas))))
  (setq ang (atan (/ pad pas)));求出的旋转角
  (entdel pl11)
  (entdel pl14)
  (setq ccs(/ (* (distance pt13 cc1) (distance pt13 pt17)) ss1));求出的肋骨冲势
(setq accs ccs)
  (setq ptt(getpoint "\n请指定插入展开图形的位置："))
  (setq n -1
        ll 0)
  (REPEAT zjlg
    (setq ll(+ ll (nth (setq n(1+ n)) zdjsc))
          )
    )
  (setq n (- zjlg 1)
        ll1 0)
  (REPEAT (- (- (fix lgs) zjlg) 1)
    (setq ll1(+ ll1 (nth (setq n(1+ n)) zdjsc))
          )
    )
  (setq ptt1(list (- (car ptt) (+ ll ccs)) (cadr ptt))
        ptt2(list (+ (car ptt) (- ll1 ccs)) (cadr ptt))
        )
  (command "line" ptt1 ptt2 "")
  ;求测地线坐标点集
  (setq n -1

CCarch

也许沧桑(1436511711)于2013-05-21 11-42-18：
;求测地线坐标点集
  (setq n -1
        po nil)
  (setq po(append po (list ptt1)))
  (repeat (length zdjsc)
    (setq pto(polar ptt1 0 (nth (setq n(1+ n)) zdjsc))
          po(append po (list pto));交点集
          )
    (setq ptt1 pto)
    )
  ;求中间肋骨上、下端点的坐标
  (setq ang1(- (/ pi 2) ang)
        ang2(+  pi ang1)
        )
  (setq pts(polar ptt ang1 (nth zjlg sdjsc))
        ptx(polar ptt ang2 (nth zjlg sdjsc))
        )
  (command "xline" pts ptx "");绘制法线
  (setq a1(entlast))
  (command"circle" (nth zjlg po ) (nth zjlg sdgsc) )
  (setq a2 (entlast))
  (setq ptss(test a1 a2))
  (setq ptss1(car ptss)
        ptss2(cadr ptss)
        )
  (if(> (cadr ptss2) (cadr ptss1))
    (setq pts ptss2)
    (setq pts ptss1)
    )
  (entdel a2)
  (command"circle" (nth zjlg po ) (nth zjlg xdgsc))
  (setq a2 (entlast))
  (setq ptss(test a1 a2))
  (setq ptss1(car ptss)
        ptss2(cadr ptss)
        )
  (if(> (cadr ptss2) (cadr ptss1))
    (setq ptx ptss1)
    (setq ptx ptss2)
    )
  (entdel a2)
  (entdel a1)
  (command "line" pts ptx "")
  (setq szj(/ (* (angle ptx pts) 180) pi))
  ;求中间肋骨前的上、下端缝点坐标
  (setq pa1 nil
        n zjlg)
  (setq pt2 pts)
  (setq pa1(append pa1 (list pts)))
  (repeat zjlg
    (setq pt1 (nth (setq n(1- n)) po)
          pl1 (nth n sdjsc)
          pl2(nth n sdgsc)
          )
    (setq pts1(dfjd pt2 pt1 pl1 pl2)
          pa1(append pa1 (list pts1));上端缝坐标
          pt2 pts1)
    )
  (setq pa2 nil
        n zjlg)
  (setq pt2 ptx)
  (setq pa2(append pa2 (list ptx)))
  (repeat  zjlg
    (setq pt1 (nth (setq n(1- n)) po)
          pl1 (nth n xdjsc)
          pl2 (nth  n xdgsc)
          )
    (setq pts2(dfjd pt2 pt1 pl1 pl2)
          pa2(append pa2 (list pts2));下端缝坐标
          pt2 pts2)
    )
  ;求中间肋骨后的上、下端缝点坐标
  (setq pb1 nil
        n zjlg)
  (setq pt2 pts)
  (repeat (-(- (fix lgs) zjlg) 1)
    (setq pt1 (nth (setq n(1+ n)) po)
          pl1 (nth (- n 1) sdjsc)
          pl2(nth n sdgsc)
          )
    (setq ptw1(dfjd1 pt2 pt1 pl1 pl2)
          pb1(append pb1 (list ptw1));上端缝坐标
          pt2 ptw1)
    )
  (setq pb2 nil
        n zjlg)
  (setq pt2 ptx)
  (repeat (-(- (fix lgs) zjlg) 1)

CCarch

也许沧桑(1436511711)于2013-05-21 11-42-28：
(repeat (-(- (fix lgs) zjlg) 1)
    (setq pt1 (nth (setq n(1+ n)) po)
          pl1 (nth (- n 1) xdjsc)
          pl2(nth n xdgsc)
          )
    (setq ptw1(dfjd1 pt2 pt1 pl1 pl2)
          pb2(append pb2 (list ptw1));下端缝坐标
          pt2 ptw1)
    )
  ;求上端缝点坐标排序
  (setq pa nil
        n (length pa1)
        )
  (repeat (length pa1)
    (setq pta(nth (setq n(1- n)) pa1)
          pa(append pa (list pta))
          )
    )
  (setq n -1)
  (repeat (length pb1)
    (setq pta(nth (setq n(1+ n)) pb1)
          pa(append pa (list pta))
          )
    )
  ;求下端缝点坐标排序
  (setq pb nil
        n (length pa2)
        )
  (repeat (length pa2)
    (setq ptb(nth (setq n(1- n)) pa2)
          pb(append pb (list ptb))
          )
    )
  (setq n -1)
  (repeat (length pb2)
    (setq ptb(nth (setq n(1+ n)) pb2)
          pb(append pb (list ptb))
          )
    )
  ;绘制上端缝
  (SETQ N 0)
  (COMMAND "PLINE" (CAR pa))
  (REPEAT (LENGTH pa)
    (COMMAND (NTH (SETQ N (1+ N)) pa))
    )
  (COMMAND "")
  (COMMAND "pedit" (entlast) "f" f "")
  ;绘制下端缝
  (SETQ N 0)
  (COMMAND "PLINE" (CAR pb))
  (REPEAT (LENGTH pb)
    (COMMAND (NTH (SETQ N (1+ N)) pb))
    )
  (COMMAND "")
  (COMMAND "pedit" (entlast) "f" f "")
  ;绘制肋骨线
  (SETQ N -1)
  (REPEAT (LENGTH po)
    (setq pt1(nth (setq n(1+ n)) pa)
          pt2(nth n po)
          pt3(nth n pb)
          )
    (command "pline" pt1 pt2 pt3 "")
    (COMMAND "pedit" (entlast) "f" f "")
    )
  ;打印型值
  ;旋转角
  (setq xzj(strcat "旋转角度:  "(rtos szj 2 1) "°   " "中间肋骨编号：" (rtos zjlg)"    ""中间肋骨冲势:  " (rtos accs 2 1)))
  (setq cd(- (length pa) 1))
  (setq zfg(/ (distance (nth cd pa) (nth cd pb))(* 2 (length pa))))
  (setq pt(list (car (nth 0 pb)) (- (cadr (nth 0 pb)) 200) 0))
  (COMMAND "text" pt zfg 0 xzj)
  ;打印上端缝肋距
  (SETQ N 0)
  (setq zf1(strcat " " "0"",  " (rtos(nth 0 sdjsc) 2 1)))
  (REPEAT (- (LENGTH sdjsc) 1)
    (setq xh(setq n(1+ n)))
    (setq zf2(strcat zf1 "   " (rtos xh)",  " (rtos(nth n sdjsc) 2 1 )))
    (setq zf1 zf2)
    )
  (setq zf11(strcat "上端缝肋距展开值： " zf1))
  (setq pt(list (car (nth 0 pb)) (- (cadr (nth 0 pb)) (+ (*   (setq zf1 zf2)
    )
  (setq zf11(strcat "下端缝肋距展开值： " zf1))
  (setq pt(list (car (nth 0 pb)) (- (cadr (nth 0 pb)) (+ (* zfg 4.5) 200)) 0))
  (COMMAND "text" pt zfg 0 zf11)
  ;打印上端肋骨展开值
  (SETQ N 0)
  (setq zf1(strcat " " "0"",  " (rtos(nth 0 sdgsc) 2 1)))
  (REPEAT (- (LENGTH sdgsc) 1)
    (setq xh(setq n(1+ n)))
    (setq zf2(strcat zf1 "   " (rtos xh)",  " (rtos(nth n sdgsc) 2 1 )))
    (setq zf1 zf2)
    )
  (setq zf11(strcat "上端肋骨展开值： " zf1))
  (setq pt(list (car (nth 0 pb)) (- (cadr (nth 0 pb)) (+ (* zfg 6) 200)) 0))
  (COMMAND "text" pt zfg 0 zf11)
  (SETQ N 0)
  (setq zf1(strcat " " "0"",  " (rtos(nth 0 xdgsc) 2 1)))
  (REPEAT (- zfg 1.5) 200)) 0))
  (COMMAND "text" pt zfg 0 zf11)
  ;打印地线肋距
  (SETQ N 0)
  (setq zf1(strcat " " "0"",  " (rtos(nth 0 zdjsc) 2 1)))
  (REPEAT (- (LENGTH zdjsc) 1)
    (setq xh(setq n(1+ n)))
    (setq zf2(strcat zf1 "   " (rtos xh)",  " (rtos(nth n zdjsc) 2 1 )))
    (setq zf1 zf2)
    )
  (setq zf11(strcat "测地线肋距展开值： " zf1))
  (setq pt(list (car (nth 0 pb)) (- (cadr (nth 0 pb)) (+ (* zfg 3) 200)) 0))
  (COMMAND "text" pt zfg 0 zf11)
  ;打印下端缝肋距
  (SETQ N 0)
  (setq zf1(strcat " " "0"",  " (rtos(nth 0 xdjsc) 2 1)))
  (REPEAT (- (LENGTH xdjsc) 1)
    (setq xh(setq n(1+ n)))
    (setq zf2(strcat zf1 "   " (rtos xh)",  " (rtos(nth n xdjsc) 2 1 )))
  (LENGTH xdgsc) 1)
    (setq xh(setq n(1+ n)))
    (setq zf2(strcat zf1 "   " (rtos xh)",  " (rtos(nth n xdgsc) 2 1 )))
    (setq zf1 zf2)

CCarch

也许沧桑(1436511711)于2013-05-21 11-42-49：
这是一个船体外板展开的插件

CCarch

真爱一生(848758009)于2013-05-21 11-44-35：
高手呀[face34.gif]

XDSoft

XDSoft(7598165)于2013-05-21 11-45-39：
贴群里面这么长代码，有必要吗

CCarch

真爱一生(848758009)于2013-05-21 11-46-30：
用手机上的就。。。。。

CCarch

长风（龙少）(8240891)于2013-05-21 11-50-02：
如何用lsp加载cui文件

CCarch

长风（龙少）(8240891)于2013-05-21 11-51-49：
如何用lsp加载cui文件

xshrimp

xshrimp(23417151)于2013-05-21 11-53-42：
加载mns就好了.cui是自动生成的.

CCarch

长风（龙少）(8240891)于2013-05-21 11-54-20：
我想用lsp的一段代码来加载

炫翔

炫翔(2363673534)于2013-05-21 12-11-01：
LOAD

CCarch

_GX_飞毅(359170905)于2013-05-21 12-24-14：
牛逼啊~

CCarch

梦回唐朝(27184507)于2013-05-21 13-52-19：
签到

CCarch

龍(358666107)于2013-05-21 13-53-00：
签到