Hello everybody!
I wonder if anyone can help me modify this lisp.
It works fine as you can see in the image below. But I need to quantify these values, and when I use a sum lisp an error happens.
Basically because arc dimensions are actually "angular dimensions".
Can someone help me?
(defun c:cpaut
(/ 2nd_point
deriv_at_point ent_bulge
ent_closed ent_entget
ent_layer ent_temp_open
line_pt1 line_pt2
mdim_clocktest mdim_counter
mdim_curdimscal mdim_curlay
mdim_curluprec mdim_curosmode
mdim_dan mdim_enttemp
mdim_enttemp2 mdim_pline_ent
mdim_pline_ent_vla
mdim_pline_pts mdim_pt1
mdim_pt2 mdim_scale
mdim_scale_dist mdim_x
mdim_x1 mdim_y
mdim_y1 midpoint_at_curve
param_at_point ron1
ron2 x
*error*
)
;;;------------------------------------------------------------------------------------
;;;load vla functions
(vl-load-com)
;;;------------------------------------------------------------------------------------
;;;error trap
(defun *error* (msg)
(command "._undo" "_end")
(setvar 'clayer mdim_curlay)
(setvar 'dimscale mdim_curdimscal)
(setvar 'luprec mdim_curluprec)
(setvar 'osmode mdim_curosmode)
(setvar 'cmdecho 1)
) ;_ end_defun
;;;------------------------------------------------------------------------------------
;;;subroutine to reverse polyline by use of pedit command
(defun mdim_revpoly (selected_pline)
(setq mdim_pt1
(vlax-curve-getendpoint
(vlax-ename->vla-object selected_pline)
) ;_ end_vlax-curve-getendpoint
) ;_ end_setq
(setq mdim_y (cadr mdim_pt1))
(setq mdim_x (car mdim_pt1))
(setq mdim_x1 (+ mdim_x 100))
(setq mdim_y1 (+ mdim_y 100))
(setq mdim_pt2 (list mdim_x mdim_y1))
(setvar 'clayer ent_layer) ; set the original layer
(command "line" "NON" mdim_pt2 "NON" mdim_pt1 "")
(setq mdim_enttemp (entlast))
(command "pedit" mdim_enttemp "y" "j" selected_pline "" "")
(setq mdim_enttemp2 (entlast))
(command "break" mdim_enttemp2 "NON" mdim_pt1 "NON" mdim_pt1) ;_ end_command
(entupd mdim_enttemp2)
(command "erase" mdim_enttemp2 "")
(setq mdim_pline_ent (ssget "l")) ; store new entity to reset the selection set
(setq mdim_pline_ent_vla ; reset the vla-object
(vlax-ename->vla-object (ssname mdim_pline_ent 0))
) ;_ end_setq
;;reset the polyline coordinates
(setq mdim_pline_pts
(mapcar
'(lambda (x) (trans x 0 1))
(mapcar
'cdr
(vl-remove-if-not
'(lambda (x) (= 10 (car x)))
(entget
(ssname mdim_pline_ent 0)
) ;_ end_entget
) ;_ end_vl-remove-if-not
) ;_ end_mapcar
) ;_ end_mapcar
) ;_ end_setq
) ;_ end_defun
;;;------------------------------------------------------------------------------------
;;;initialization
(setvar 'cmdecho 0)
(command "._undo" "_end")
(command "._undo" "_begin")
(setq mdim_curlay (getvar 'clayer))
(setq mdim_curdimscal (getvar 'dimscale))
(setq mdim_curluprec (getvar 'luprec))
(setq mdim_curosmode (getvar 'osmode))
(setvar 'osmode 0)
(command
"Layer" "m" "DIMS" "unlock" "DIMS" "thaw" "DIMS" "on" "DIMS" "c" "6" "DIMS" "") ;_ end_command
;_ end_command
;_ end_command
;;;------------------------------------------------------------------------------------
;;;user input function by Cab used to set dimscale
(while
(progn
(setq mdim_scale
(cond ((getint "\nEnter the drawing scale [20/30/50] <50>: "))
(50)
) ;_ end_cond
) ;_ end_setq
(if (not (vl-position mdim_scale '(1 20 30 50)))
(not
(prompt "\nChoose only from 20 30 & 50, please re-enter.")
) ;_ end_not
) ;_ end_if
) ;_ end_progn
) ;_ end_while
(cond
((= mdim_scale 1) (setq mdim_scale_dist 1))
((= mdim_scale 20) (setq mdim_scale_dist 140))
((= mdim_scale 30) (setq mdim_scale_dist 210))
((= mdim_scale 50) (setq mdim_scale_dist 350))
) ;_ end_cond
(setvar 'dimscale mdim_scale)
;;;------------------------------------------------------------------------------------
;;;Pick Entity
(while
(not
(setq
mdim_pline_ent
(ssget ":E:S" '((0 . "LWPOLYLINE")))
) ;_ end_setq
) ;_ end_not
(princ "\nMISSED....PICK AGAIN")
) ;_ end_while
(setq mdim_pline_entname (ssname mdim_pline_ent 0))
(setq ent_layer (cdr (assoc 8 (entget mdim_pline_entname)))) ; store the original layer
(setq mdim_pline_pts
(mapcar
'(lambda (x) (trans x 0 1))
(mapcar
'cdr
(vl-remove-if-not
'(lambda (x) (= 10 (car x)))
(entget
(ssname mdim_pline_ent 0)
) ;_ end_entget
) ;_ end_vl-remove-if-not
) ;_ end_mapcar
) ;_ end_mapcar
) ;_ end_setq
;;;------------------------------------------------------------------------------------
;;;subroutine for clockwise/counterclockwise test, author LE,fatty(not sure)?
(defun clockwise-p (p1 p2 p3)
(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
) ;_ end_defun
;;;------------------------------------------------------------------------------------
;;;If selected polyline is closed, get the bulge at the end segment, then open it by
;;;setting dxf code 70 to 0. Set Ent_temp_open to T to flag that the polyline is temporarily
;;;opened
(if (= (setq ent_closed
(cdr (assoc 70 (entget mdim_pline_entname)))
) ;_ end of setq
1
) ;_ end of =
(progn
(setq ent_bulge
(vla-getbulge
(vlax-ename->vla-object mdim_pline_entname)
(1-
(vlax-curve-getendparam
(vlax-ename->vla-object mdim_pline_entname)
) ;_ end_vlax-curve-getendparam
) ;_ end_1-
) ;_ end_vla-getbulge
) ;_ end_setq
(setq ent_entget (entget mdim_pline_entname))
(if (not (Setq mdim_clocktest
(clockwise-p
(car mdim_pline_pts)
(cadr mdim_pline_pts)
(caddr mdim_pline_pts)
) ;_ end_clockwise-p
) ;_ end_Setq
) ;_ end_not
(progn
(entmod (subst (cons 70 0) (assoc 70 ent_entget) ent_entget))
(setq ent_temp_open t)
) ;_ end_progn
) ;_ end_if
) ;_ end_progn
;;; (if (equal
;;; (vlax-curve-getpointatparam
;;; (vlax-ename->vla-object mdim_pline_entname)
;;; (vlax-curve-getendparam
;;; (vlax-ename->vla-object mdim_pline_entname)
;;; ) ;_ end_vlax-curve-getendparam
;;; ) ;_ end_vlax-curve-getpointatparam
;;; (vlax-curve-getpointatparam
;;; (vlax-ename->vla-object mdim_pline_entname)
;;; (vlax-curve-getstartparam
;;; (vlax-ename->vla-object mdim_pline_entname)
;;; ) ;_ end_vlax-curve-getstartparam
;;; ) ;_ end_vlax-curve-getpointatparam
;;; ) ;_ end_equal
;;; (progn(setq ent_entget (entget mdim_pline_entname))
;;; (entmod (subst (cons 70 1) (assoc 70 ent_entget) ent_entget))
;;; (setq ent_orig_open 1))
;;; ) ;_ end_if
) ;_ end_if
;;;------------------------------------------------------------------------------------
;;;after Selected Polyline is now open or temporarily open, there are cases that end point
;;;and start point of the polyline lies in the same coordinates even it is open already.
;;;Remedy is to break the polyline at the last segment and delete the small segment
;;;to make it completely open.
(setq mdim_pline_ent_vla (vlax-ename->vla-object (ssname mdim_pline_ent 0)))
(if (and (equal
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getendparam
mdim_pline_ent_vla
) ;_ end_vlax-curve-getendparam
) ;_ end_vlax-curve-getpointatparam
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getstartparam
mdim_pline_ent_vla
) ;_ end_vlax-curve-getstartparam
) ;_ end_vlax-curve-getpointatparam
) ;_ end_equal
(not (Setq mdim_clocktest
(clockwise-p
(car mdim_pline_pts)
(cadr mdim_pline_pts)
(caddr mdim_pline_pts)
) ;_ end_clockwise-p
) ;_ end_Setq
) ;_ end_not
) ;_ end_and
(progn
(command
"break"
mdim_pline_entname
"non"
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam
mdim_pline_ent_vla
) ;_ end_vlax-curve-getendparam
) ;_ end_1-
) ;_ end_vlax-curve-getpointatparam
"non"
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam
mdim_pline_ent_vla
) ;_ end_vlax-curve-getendparam
) ;_ end_1-
) ;_ end_vlax-curve-getpointatparam
) ;_ end_command
;;after breaking, get the bulge of the small segment, to restore it later
(setq ent_bulge
(vla-getbulge
(vlax-ename->vla-object (entlast))
(1-
(vlax-curve-getendparam (vlax-ename->vla-object (entlast)))
) ;_ end_1-
) ;_ end_vla-getbulge
) ;_ end of setq
(entdel (entlast)) ;_ delete the small entity to make polyline completely open
(setq ent_temp_open t)
) ;_ end_progn
) ;_ end_if
;;;------------------------------------------------------------------------------------
;;;test if the selected polyline is clockwise/ counterclockwise. If counterclockwise,
;;;run mdim_revpoly subroutine to reverse polyline direction.
;;;There is a need to reverse polyline coordinates in order to place dimensions on
;;;the correct side of polyline
(if (not
(Setq mdim_clocktest
(clockwise-p
(car mdim_pline_pts)
(cadr mdim_pline_pts)
(caddr mdim_pline_pts)
) ;_ end_clockwise-p
) ;_ end_Setq
) ;_ end_not
(mdim_revpoly (ssname mdim_pline_ent 0))
) ;_ end_if
;;;------------------------------------------------------------------------------------
;;;begin processing each segment
;;;mdim_counter is the parameter counter
(setq mdim_counter 0)
(while
(< mdim_counter
(fix
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_fix
) ;_ end_<
(setq line_pt1 ;_startpoint at segment
(vlax-curve-getpointatparam mdim_pline_ent_vla mdim_counter)
) ;_ end_setq
(setq line_pt2 ;_endpoint at segment
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(1+ mdim_counter)
) ;_ end_vlax-curve-getpointatparam
) ;_ end_setq
(command "._layer" "s" "DIMS" "") ;_set layer to dims
;;if bulge at segment is 0.0 then it is straight
(if (= (vla-getbulge mdim_pline_ent_vla mdim_counter) 0.0)
;;if it is straight perform simple dimaligned
(progn
(princ "\nstraight")
(command
"._dimaligned"
"non"
line_pt1
"non"
line_pt2
"non"
(polar
line_pt2
(+ (angle line_pt1 line_pt2) (/ pi 2))
mdim_scale_dist
) ;_ end_polar
) ;_ end_command
) ;_ end_progn
;;if it is curved get the midpoint of curve
(progn
(princ "\ncurve")
(setq midpoint_at_curve ;_midpoint of curve
(vlax-curve-getpointatdist
mdim_pline_ent_vla
(+
(*
(-
(vlax-curve-getdistatparam
mdim_pline_ent_vla
(1+ mdim_counter)
) ;_ end of vlax-curve-getdistatparam
(vlax-curve-getdistatparam
mdim_pline_ent_vla
mdim_counter
) ;_ end of vlax-curve-getdistatparam
) ;_ end of -
0.5
) ;_ end of *
(vlax-curve-getdistatparam mdim_pline_ent_vla mdim_counter)
) ;_ end of +
) ;_ end of vlax-curve-getpointatdist
) ;_ end of setq
;;Get parameter at midpoint of curve
(setq param_at_point
(vlax-curve-getparamatpoint
mdim_pline_ent_vla
midpoint_at_curve
) ;_ end of vlax-curve-getparamatpoint
) ;_ end of setq
;;Get derivative at midpoint of curve
(setq deriv_at_point
(vlax-curve-getfirstderiv
mdim_pline_ent_vla
param_at_point
) ;_ end of vlax-curve-getfirstderiv
) ;_ end of setq
(setq 2nd_point (mapcar '+ midpoint_at_curve deriv_at_point)) ;_ this is for getting angle at curve's midpoint
(command
"._dimangular"
"" ;_3point vertex
;; snap to center of curve based on curve's midpoint
(osnap (vlax-curve-getpointatparam
mdim_pline_ent_vla
param_at_point ;(1+ mdim_counter)
) ;_ end_vlax-curve-getpointatparam
"_cen"
) ;_ end_osnap
line_pt1 ;_ startpoint of segment
line_pt2 ;_ endpoint of segment
"non"
(polar
midpoint_at_curve
(+ (angle midpoint_at_curve 2nd_point) (/ pi 2))
;_angle at curve's midpoint rotated by 90deg.
mdim_scale_dist
) ;_ end_polar
) ;_ end_command
;;store dimension object
(setq mdim_dan (vlax-ename->vla-object (entlast)))
;(setvar 'luprec 0)
;;begin dimension override
(vla-put-TextOverride
mdim_dan
(rtos
(- (Setq ron1 (vlax-curve-getdistatparam
mdim_pline_ent_vla
(1+ mdim_counter)
) ;_ end_vlax-curve-getdistatparam
) ;_ end_vlax-curve-getdistatparam
(Setq ron2 (vlax-curve-getdistatparam
mdim_pline_ent_vla
mdim_counter
) ;_ end of vlax-curve-getdistatparam
) ;_ end of Setq
) ;_ end_-
2
0
) ;_ end_-
) ;_ end_-
) ;_ end_vla-put-TextOverride
) ;_ end_progn
(setq mdim_counter (1+ mdim_counter))
) ;_ end_while
;;;------------------------------------------------------------------------------------
;;;if ent_temp_open is T, then we need to close the polyline since it is closed originally
;;;
(if ent_temp_open
(progn
(entmod (subst (cons 70 1)
(assoc 70 (entget (ssname mdim_pline_ent 0)))
(entget (ssname mdim_pline_ent 0))
) ;_ end of subst
) ;_ end of entmod
;;------------------------------------------------------------------------------------
;;restore the original bulge of the last segment
(if (/= ent_bulge 0.0)
(progn
(vla-setbulge
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
(* ent_bulge -1) ;_ to reverse the direction of bulge
) ;_ end_vla-setbulge
;;get the mipoint of curve at last segment
(setq midpoint_at_curve
(vlax-curve-getpointatdist
mdim_pline_ent_vla
(+
(*
(-
(vlax-curve-getdistatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end of vlax-curve-getdistatparam
(vlax-curve-getdistatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
) ;_ end of vlax-curve-getdistatparam
) ;_ end of -
0.5
) ;_ end of *
(vlax-curve-getdistatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
) ;_ end_vlax-curve-getdistatparam
) ;_ end_+
) ;_ end_vlax-curve-getpointatdist
) ;_ end_setq
;;get parameter at midpoint of curve (last segment)
(setq param_at_point
(vlax-curve-getparamatpoint
mdim_pline_ent_vla
midpoint_at_curve
) ;_ end of vlax-curve-getparamatpoint
) ;_ end of setq
;;get derivative at midpoint of curve (last segment)
(setq deriv_at_point
(vlax-curve-getfirstderiv
mdim_pline_ent_vla
param_at_point
) ;_ end of vlax-curve-getfirstderiv
) ;_ end of setq
(setq 2nd_point (mapcar '+ midpoint_at_curve deriv_at_point))
;;put dimension at last segment of curve
(command
"._dimangular"
""
(osnap (vlax-curve-getpointatparam
mdim_pline_ent_vla
param_at_point
) ;_ end_vlax-curve-getpointatparam
"_cen"
) ;_ end_osnap
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
) ;_ end_vlax-curve-getpointatparam
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_vlax-curve-getpointatparam
"non"
(polar
midpoint_at_curve
(+ (angle midpoint_at_curve 2nd_point) (/ pi 2))
mdim_scale_dist
) ;_ end_polar
) ;_ end_command
(setq mdim_dan (vlax-ename->vla-object (entlast)))
;(setvar 'luprec 0)
(vla-put-TextOverride
mdim_dan
(rtos
(- (Setq
ron1 (vlax-curve-getdistatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_vlax-curve-getdistatparam
) ;_ end_vlax-curve-getdistatparam
(Setq ron2
(vlax-curve-getdistatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end of 1-
) ;_ end of vlax-curve-getdistatparam
) ;_ end of Setq
) ;_ end_-
2
0
) ;_ end_rtos
) ;_ end_vla-put-TextOverride
) ;_ end_progn
;;------------------------------------------------------------------------------------
;;Else, if last segment if straight, put dimension on last segment
(command
"._dimaligned"
"non"
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
) ;_ end_vlax-curve-getpointatparam
"non"
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_vlax-curve-getpointatparam
"non"
(polar
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_vlax-curve-getpointatparam
(+ (angle (vlax-curve-getpointatparam
mdim_pline_ent_vla
(1- (vlax-curve-getendparam mdim_pline_ent_vla))
) ;_ end_vlax-curve-getpointatparam
(vlax-curve-getpointatparam
mdim_pline_ent_vla
(vlax-curve-getendparam mdim_pline_ent_vla)
) ;_ end_vlax-curve-getpointatparam
) ;_ end_angle
(/ pi 2)
) ;_ end_+
mdim_scale_dist
) ;_ end_polar
) ;_ end_command
) ;_ end_progn
) ;_ end_if
) ;_ end of if
(*error* "") ; force error trap
(princ)
) ;_ end_defun
(princ)
