如果你看这个lisp,它会使用间距增量沿着pline重复绘制一个块。它还使用两个点来正确旋转。同样的理论可以应用于具有上下链迭代的链环。要进行测试,只需制作一个水平线长度为3.05的块,插入点位于右端。
- (Defun draw_vehicle ( )
- (SETQ ANGBASEE (GETVAR "ANGBASE"))
- (SETQ ANGDIRR (GETVAR "ANGDIR"))
- (SETQ LUNITSS (GETVAR "LUNITS"))
- (SETQ LUPRECC (GETVAR "LUPREC"))
- (SETQ AUNITSS (GETVAR "AUNITS"))
- (SETQ AUPRECC (GETVAR "AUPREC"))
- (setq oldsnap (getvar "osmode"))
- (SETVAR "LUNITS" 2)
- (SETVAR "ANGBASE" 0.0)
- (SETVAR "ANGDIR" 0)
- (SETVAR "LUPREC" 0)
- (SETVAR "AUNITS" 3)
- (SETVAR "AUPREC" 0)
- (setvar "osmode" 0)
- ;(if (tblsearch "Block" "Holden")
- ;(princ "Holden")
- ;(progn
- ;(command "Insert" "p:\\Autodesk\\vba\\holdencar.dwg" "0,0" 1 1 0)
- ;(command "erase" "last" "")
- ; progn
- (setq obj (vlax-ename->vla-object (car (entsel "\nPick Pline"))))
- (setq interval ( getreal "\nEnter spacing m:"))
- (setq cRad 3.05)
- (setq startang (* pi 1.5))
- (setq endang (/ pi 2.0))
- (setq dist 0.0)
- (setq len (vla-get-length obj))
- (setq stpt (vlax-curve-getpointatdist obj interval))
- (setq num (+ 1 (fix ( / len interval))))
- (repeat num
- (command "arc" "C" stpt (polar stpt endang crad)(polar stpt startang crad))
- (setq objarc (vlax-ename->vla-object (entlast)))
- (if (= (setq intpt (vlax-invoke obj 'intersectWith objarc acExtendnone)) nil)
- (setq intpt (vlax-invoke obj 'intersectWith objarc acExtendThisEntity)) ; needed at start
- )
- (vla-delete objarc)
- (setq ang (angle intpt stpt))
- (command "Insert" "Holden" stpt 1 1 ang) ; need ang in radians
- (setq stpt (vlax-curve-getpointatdist obj (setq dist (+ dist interval))))
- ) ; repeat
- (SETVAR "LUNITS" lunitss)
- (SETVAR "ANGBASE" angbasee)
- (SETVAR "ANGDIR" angdirr)
- (SETVAR "LUPREC" luprecc)
- (SETVAR "AUNITS" aunitss)
- (SETVAR "AUPREC" auprecc)
- (princ)
- ) ; defun
- (draw_vehicle)
|