Community
Hi everyone
I got this code from cadtutor and tried to modify to suit my needs mostly in civil works.
But still having a problem with it.
For example;
top of batter location (blue line) =on top
bottom batter location (red line) =on bottom
the batter symbol is ok.
but when;;;;
top of batter location (blue line) =on bottom
bottom batter location (red line) =on top
the batter symbol is inverted
here's the output that I want to achieve
(vl-load-com) (defun alg-ang (obj pnt) (- (angle '(0. 0. 0.)(vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt)))(/ pi 2))) (defun C:test (/ stepLength endPt startPt divStep) (COMMAND "_UNDO" "_M") (setq acadApp (vlax-get-acad-object)) (setq acadDoc (vla-get-ActiveDocument acadApp)) (setq acSp (vla-get-modelspace acadDoc)) (setq a '(0.0 0.0 0.0)) (command "-insert" "tick" "_s" "1" a "0") (command "_erase" "l" "") (if(not(tblsearch "LAYER" "C-BATR_SYMB")) (command "-layer" "new" "C-BATR_SYMB" "Color" 252 "C-BATR_SYMB" "LTYPE" "Continuous" "C-BATR_SYMB" "")) (setvar "clayer" "C-BATR_SYMB") (setvar "celtype" "bylayer") (setvar "cecolor" "bylayer") (setq distbetween (getreal(strcat"\nSPECIFY DISTANCE BETWEEN BATTER TICKS: "))) (setq divStep distbetween stepLength 0.0 stepLength2 divstep ) (setq BottomObj (vlax-ename->vla-object (car (entsel "\nSELECT TOP OF BATTER>>")))) (setq UpperObj (vlax-ename->vla-object (car (entsel "\nSELECT BOTTOM OF BATTER >>")))) (setq objLength (vlax-curve-getDistAtParam BottomObj (vlax-curve-getEndParam BottomObj))) (while (< stepLength objLength) (setq startPt (vlax-curve-getPointAtDist BottomObj stepLength)) (setq startPt2 (vlax-curve-getPointAtDist BottomObj stepLength2)) (setq endPt (vlax-curve-getClosestPointTo UpperObj startPt) ) (setq endPt2 (vlax-curve-getClosestPointTo UpperObj startPt2) ) (setq ang (alg-ang BottomObj startPt)) (setq ang2 (alg-ang BottomObj startPt2)) (setq dis (distance startPt endPt)) (setq dis2 (/ (distance startPt2 endPt2) 2) ) (setq endPt (polar startPt ang 1.)) (setq endPt2 (polar startPt2 ang2 1.)) (setq Xline (vlax-invoke acSp 'AddXLine startPt endPt)) (setq Xline2 (vlax-invoke acSp 'AddXLine startPt2 endPt2)) (if (setq endPt (vlax-invoke Xline 'IntersectWith UpperObj 0)) (progn (vlax-invoke acSp 'InsertBlock startPt "tick" 1 1 1 (- ang (* pi 2)));<-- change the block name here (vl-cmdf "_.scale" "l" "" startPt dis ) ));end if (vla-delete Xline) (setq stepLength (+ stepLength divStep)) ;end if (vla-delete Xline2) (setq stepLength2 (+ stepLength2 divStep)) ) (vlax-release-object BottomObj) (vlax-release-object UpperObj) (princ) (COMMAND "_UNDO" "_E") )