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") )
Solved! Go to Solution.
Solved by marlance. Go to Solution.
Solved by marlance. Go to Solution.
Hi,My try with this...
Is not necessary that polyline have constant offset, the scale of block "TICK" is adjusted
(vl-load-com) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun c:batter ( / js_b ent_b vla_obj_b param_start_b pram_end_b perim_obj pt_start_b deriv alpha js_t ent_t vla_obj_t param_start_t pt_start_t v1 v2 det_or len_vtx d_x pt_ins param_pt pt_first pt_snd dxf_210 scale) (vl-load-com) (princ "\nSELECT BOTTOM OF BATTER >>") (while (not (setq js_b (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<NOT") (cons -4 "&") (cons 70 120) (cons -4 "NOT>") ) ) ) ) ) (setq ent_b (ssname js_b 0) vla_obj_b (vlax-ename->vla-object ent_b) param_start_b (vlax-curve-getStartParam vla_obj_b) param_end_b (vlax-curve-getEndParam vla_obj_b) perim_obj (vlax-curve-getDistAtParam vla_obj_b param_end_b) pt_start_b (vlax-curve-getPointAtParam vla_obj_b param_start_b) deriv (vlax-curve-getFirstDeriv vla_obj_b param_start_b) alpha (atan (cadr deriv) (car deriv)) ) (princ "\nSELECT TOP OF BATTER>>") (while (not (setq js_t (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<NOT") (cons -4 "&") (cons 70 120) (cons -4 "NOT>") ) ) ) ) ) (if (not (tblsearch "LAYER" "C-BATR_SYMB")) (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "C-BATR_SYMB") (70 . 0) (62 . 252) (370 . -3) (6 . "Continuous") ) ) ) (setq ent_t (ssname js_t 0) vla_obj_t (vlax-ename->vla-object ent_t) param_start_t (vlax-curve-getStartParam vla_obj_t) pt_start_t (vlax-curve-getPointAtParam vla_obj_t param_start_t) ) (setq v1 (mapcar '- (polar pt_start_b alpha 1.0) pt_start_b) v2 (mapcar '- (vlax-curve-getClosestPointTo vla_obj_t pt_start_b ) pt_start_b ) det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2) ) ) (cond ((< det_or 0.0) (setq ang_dir (- (* 0.5 pi)))) ((> det_or 0.0) (setq ang_dir (* 0.5 pi))) ) (if (not (tblsearch "BLOCK" "TICK")) (progn (entmake '( (0 . "BLOCK") (8 . "0") (2 . "TICK") (70 . 2) (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0) ) ) (entmake '( (0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine") (10 0.0 0.0 0.0) (11 0.5 -9.18455e-017 0.0) (210 0.0 0.0 1.0) ) ) (entmake '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbPolyline") (90 . 3) (70 . 129) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.5 -9.18455e-017) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.933013 -0.25) (40 . 0.0) (41 . 0.0) (42 . 0.267949) (91 . 0) (10 0.933013 0.25) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0) ) ) (entmake '( (0 . "ENDBLK") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) ) ) ) ) (initget 7) (setq len_vtx (getdist "\nSPECIFY DISTANCE BETWEEN BATTER TICKS: ")) (setq d_x 0.0) (while (< d_x perim_obj) (setq pt_ins (vlax-curve-getPointAtDist vla_obj_b d_x) param_pt (vlax-curve-getParamAtPoint vla_obj_b pt_ins) pt_first (vlax-curve-getPointAtParam vla_obj_b (fix param_pt)) pt_snd (vlax-curve-getPointAtParam vla_obj_b (1+ (fix param_pt))) deriv (vlax-curve-getFirstDeriv vla_obj_b param_pt) alpha (atan (cadr deriv) (car deriv)) ) (if (null pt_snd) (setq pt_snd (vlax-curve-getEndPoint vla_obj_b)) ) (setq dxf_210 (z_dir pt_first pt_snd) scale (distance pt_ins (vlax-curve-getClosestPointTo vla_obj_t pt_ins))) (entmake (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (assoc 67 (entget ent_b)) (assoc 410 (entget ent_b)) (cons 8 "C-BATR_SYMB") (cons 100 "AcDbBlockReference") (cons 2 "TICK") (cons 10 (trans (vlax-curve-getPointAtDist vla_obj_b d_x) 0 dxf_210)) (cons 41 scale) (cons 42 scale) (cons 43 scale) (cons 50 (+ alpha ang_dir)) (cons 210 dxf_210) ) ) (setq d_x (+ d_x len_vtx)) ) (prin1) )
@CADaSchtroumpf wrote:Hi,My try with this...
Is not necessary that polyline have constant offset, the scale of block "TICK" is adjusted
Hi
works fine now but I want to change the shape of the batter with the drawing attached below.
I tried to modify the entmaking of the line and polyline but still can't manage to change shape of the batter.
(entmake '( (0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine") (10 0.0 0.0 0.0);;;;;is this the first point of the line? (11 0.5 -9.18455e-017 0.0);;;;second point of the line?
(210 0.0 0.0 1.0)
and how about the polyline?
how can i change the shape?
Hi,
For change the shape, replace
(if (not (tblsearch "BLOCK" "TICK")) (progn ... ... ) )
by this:
(if (not (tblsearch "BLOCK" "TICK")) (progn (entmake '( (0 . "BLOCK") (8 . "0") (2 . "TICK") (70 . 2) (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0) ) ) (entmake '( (0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine") (10 0.0 0.0 0.0) (11 0.47245 0.0 0.0) (210 0.0 0.0 1.0) ) ) (entmake '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbPolyline") (90 . 16) (70 . 129) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 0.47245 0.0) (40 . 0.0) (41 . 0.0) (42 . -0.116132) (91 . 0) (10 0.4951 -0.0065) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.7458 -0.1695) (40 . 0.0) (41 . 0.0) (42 . 0.0607686) (91 . 0) (10 0.869 -0.2337) (40 . 0.0) (41 . 0.0) (42 . 0.279764) (91 . 0) (10 0.9038 -0.226) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.9378 -0.1977) (40 . 0.0) (41 . 0.0) (42 . 0.167269) (91 . 0) (10 0.983 -0.113) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.9943 -0.0564) (40 . 0.0) (41 . 0.0) (42 . 0.0504035) (91 . 0) (10 1.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0504035) (91 . 0) (10 0.9943 0.0564) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.983 0.113) (40 . 0.0) (41 . 0.0) (42 . 0.167269) (91 . 0) (10 0.9378 0.1977) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.9038 0.226) (40 . 0.0) (41 . 0.0) (42 . 0.279764) (91 . 0) (10 0.869 0.2337) (40 . 0.0) (41 . 0.0) (42 . 0.0607686) (91 . 0) (10 0.7458 0.1695) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.4951 0.0065) (40 . 0.0) (41 . 0.0) (42 . -0.116132) (91 . 0) (210 0.0 0.0 1.0) ) ) (entmake '( (0 . "ENDBLK") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) ) ) ) )
Is the TICK.dwg, but I have moved the insertion point and the rotation (180°) and parameter is fixed at "ByBlock"
Hi
can you rotate the block to 180° and move the insertion point.
the insertion point should be on top that's why i want it to be like this.
problem solved already
just change the value of those highlighted in red
(cond
((< det_or 0.0) (setq ang_dir (- (/ (* 3 pi) 2 ))))
((> det_or 0.0) (setq ang_dir (/ (* 3 pi) 2 )))
...................
(if (not (tblsearch "BLOCK" "TICK"))
(progn
(entmake
'(
(0 . "BLOCK")
(8 . "0")
(2 . "TICK")
(70 . 2)
(62 . 0)
(6 . "ByBlock")
(370 . -2)
(10 1.0 0.0 0.0)
..................................