[练习]一步一步写动态小程序

liminet

那你给个代码看看 光说不练假把式

吃完饭 接着干

(defun 3ptsBroke(pt1 pt2 pt3);3个点转为转弯所有点(包括圆弧计算)
 (setq ang12 (angle pt1 pt2))
 (setq ang32 (angle pt3 pt2))
 
 (setq pt_1a (polar pt1 (- ang12 pi90) (* 0.5 width)))
 (setq pt_1b (polar pt1 (+ ang12 pi90) (* 0.5 width)))
 (setq pt_3a (polar pt3 (+ ang32 pi90) (* 0.5 width)))
 (setq pt_3b (polar pt3 (- ang32 pi90) (* 0.5 width)))
 
 (setq ang12 (angle pt1 pt2) ang32 (angle pt3 pt2))
 (setq ang21 (angle pt2 pt1) ang23 (angle pt2 pt3))
 
 (setq pt_1a_2a (polar pt_1a ang12 0.01))
 (setq pt_3a_2a (polar pt_3a ang32 0.01))
 (setq pt_1b_2b (polar pt_1b ang12 0.01))
 (setq pt_3b_2b (polar pt_3b ang32 0.01))
 
 (setq pt_2a (inters pt_1a pt_1a_2a pt_3a pt_3a_2a nil));拐点2点搞定
 (setq pt_2b (inters pt_1b pt_1b_2b pt_3b pt_3b_2b nil));拐点2点搞定
 
 (setq dis2a2b (distance pt_2a pt_2b))
 (setq p_cen (polar pt_2a (angle pt_2a pt_2b) dis2a2b))
 (setq pt_c1a (polar pt_2a ang21 (sqrt (- (* 4 dis2a2b dis2a2b) (* 4 width width)))))
 (setq pt_c1b (polar pt_2b ang21 (sqrt (- (* dis2a2b dis2a2b) (* width width)))))
 
 (setq pt_c3a (polar pt_2a ang23 (sqrt (- (* 4 dis2a2b dis2a2b) (* 4 width width)))))
 (setq pt_c3b (polar pt_2b ang23 (sqrt (- (* dis2a2b dis2a2b) (* width width)))))
 
 
)

luyu9635

精神可嘉，顶一下

5061220

liminet发表于2009-8-27 22:22:00不为名不为利真正的回报明经

淮上

__________________________________________

AMTONNY

liminnet发表于2009-8-28 16:49:00兄弟，你的的代码内容的水不够深呢，拿的复杂的出来呀

嘿嘿，光说不动，可惜偶是菜鸟，拿不出高深的东东哦，但是为了本站不会编程的会员送上本人的常用工具，高手莫看哦，

liminet

liminnet发表于2009-8-28 16:49:00兄弟，你的的代码内容的水不够深呢，拿的复杂的出来呀

你自称是大师,就给大家讲讲我这的代码是做什么的吧~

(setq ob (car (setq get (entsel))))
 (Vlax-Invoke-Method (setq blk (Vlax-Ename->Vla-Object ob)) 'GetXData "Test" 'a 'b)
 (setq blkname (vla-get-name blk))
 (setq Blks (Vlax-Invoke-Method (Vlax-Get Doc 'Blocks) 'Item blkname))
 (if (and b (= "Road" (vlax-variant-value (cadr (vlax-safearray->list b)))))
  (progn
   (vlax-for item Blks
    (setq objectName (Vlax-Get item 'ObjectName ))
    (cond
     ((= "AcDbPoint" objectName)
      (setq pts (append pts (list (trans (Vlax-Get item 'Coordinates ) 0 1))))
     )
    )
   )
  )
 )

(cond
    ((= DrawMode 0);逆时针
     (com "line" (list pt_1a pt_c1a pt_1b pt_c1b))
     (setq pta pt_1a ptc pt_1b ptb (polar (GetMidPt pt_1a pt_1b) ang12 (* 0.3 ArcWidth)))
     (setq long (distance pt_1a pt_c1a))
     (while (> long (+ ArcLong (* 0.3 ArcWidth)))
      (command "_.Arc" pta ptb ptc)
      (setq long (- long Arclong))
      (setq pta (polar pta ang12 Arclong)
         ptc (polar ptc ang12 Arclong)
         ptb (polar ptb ang12 Arclong)
      )
     )
     (command "_.Arc" pt_c1a pt_c2a pt_c3a)
     (command "_.Arc" pt_c1b pt_c2b pt_c3b)
     (setq pt_z1 (GetMidPt pt_c1a pt_c1b));中间圆弧
     (setq pt_z2 (GetMidPt pt_c2a pt_c2b))
     (setq pt_z3 (GetMidPt pt_c3a pt_c3b))
     
     (setq long_left long);刚才剩下的部分
     (command "_.Arc" pt_z1 pt_z2 pt_z3)
     (setq las_arc (Vlax-Ename->Vla-Object (entlast)))
     (setq long (Vlax-Get las_arc 'ArcLength ))
     (setq pta pt_c1a ptc pt_c1b)
       (setq pt_st pt_z1)
       (setq ptb (vlax-curve-getPointAtDist las_arc (* 0.3 ArcWidth)))
       (setq ptb (trans ptb 0 1))
       (setq j 0)
       (while (> long (* Arclong (+ j 0.3)))
        (command "_.Arc" pta ptb ptc)
        (setq long (- long Arclong))
        (setq ptb (vlax-curve-getPointAtDist las_arc (* Arclong (setq j (1+ j)))))
        (setq ptb (trans ptb 0 1))
        (setq pta (polar pt_cen (angle pt_cen ptb) ArcWidth))
        (setq ptc (polar pt_cen (angle pt_cen ptb) (* ArcWidth 2)))        
        (setq ptb (vlax-curve-getPointAtDist las_arc (* Arclong (+ j 0.3))))
        (setq ptb (trans ptb 0 1))
       )
     (Vlax-Invoke-Method las_arc 'Delete )
    )
    ((= DrawMode 1);顺时针
     (com "line" (list pt_3a pt_c3a pt_3b pt_c3b))
     (setq long (distance pt_3a pt_c3a))
     (setq pta pt_3a ptc pt_3b ptb (polar (GetMidPt pt_3a pt_3b) ang32 (* 0.3 ArcWidth)))
     (while (> long (+ ArcLong (* 0.3 ArcWidth)))
      (command "_.Arc" pta ptb ptc)
      (setq long (- long Arclong))
      (setq pta (polar pta ang32 Arclong)
         ptc (polar ptc ang32 Arclong)
         ptb (polar ptb ang32 Arclong)
      )
     )
     (command "_.Arc" pt_c1a pt_c2a pt_c3a)
     (command "_.Arc" pt_c1b pt_c2b pt_c3b)
     
     
     (setq pt_z1 (GetMidPt pt_c3a pt_c3b));中间圆弧
     (setq pt_z2 (GetMidPt pt_c2a pt_c2b))
     (setq pt_z3 (GetMidPt pt_c1a pt_c1b))
     (setq long_left long);刚才剩下的部分
     (command "_.Arc" pt_z1 pt_z2 pt_z3)
     (setq las_arc (Vlax-Ename->Vla-Object (entlast)))
     (setq long (Vlax-Get las_arc 'ArcLength ))
     (setq pta pt_c3a ptc pt_c3b)
       (setq pt_st pt_z1)
       (setq ptb (vlax-curve-getPointAtDist las_arc (- long (* 0.3 ArcWidth))))
       (setq ptb (trans ptb 0 1))
       (setq j 1)
       (while (> long (* Arclong (+ j 0.3)))
        (command "_.Arc" pta ptb ptc)
        (setq ptb (vlax-curve-getPointAtDist las_arc (- long (* Arclong j))))
        (setq ptb (trans ptb 0 1))
        (setq pta (polar pt_cen (angle pt_cen ptb) ArcWidth))
        (setq ptc (polar pt_cen (angle pt_cen ptb) (* ArcWidth 2)))        
        (setq ptb (vlax-curve-getPointAtDist las_arc (- long (* Arclong (+ j 0.3)))))
        (setq ptb (trans ptb 0 1))
        (setq j (1+ j))
       )
     (Vlax-Invoke-Method las_arc 'Delete )
    )
   )

AMTONNY

楼主高明，本菜鸟有个不情之请，不知道能否帮忙把我那求助的多个圆弧同时偏移不同中离的贴子改正一下，我已经贴出两天了，为了防止下沉，我每天都要自已顶上来，谢谢！如需详细讨论请加我QQ417506925。