Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/29/2021 in all areas

  1. Sorry couldn't resist it:
    2 points
  2. Hi all, I have this lisp routine I downloaded from the web but it is in imperial dims and I need it to be metric meters to 3 decimal points the angles are in degrees and fine. Not great with lisp so any help appreciated. Judi DimPline.lsp
    1 point
  3. (defun c:DimPline2 ( / adoc space obj_dim obj_angdim height_dim pl ent obj dxf_ent ll ur dir_pt base_pt dir_ang last_pt pr_pt lst_pt nw_obj) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) space (if (= 1 (getvar "CVPORT")) (vla-get-paperspace adoc) (vla-get-modelspace adoc) ) obj_dim (vla-add (vla-get-Dimstyles adoc) "DIMPLINE") obj_angdim (vla-add (vla-get-Dimstyles adoc) "DIMANGPLINE") ) (vla-put-activedimstyle adoc obj_dim) (initget 6) (setq height_dim (getdist (getvar "VIEWCTR") (strcat "\nHeight of dim text <" (rtos (getvar "DIMTXT")) ">: "))) (if height_dim (vla-setvariable adoc "DIMTXT" height_dim) (setq height_dim (getvar "DIMTXT"))) (mapcar '(lambda (data_list / ) (vla-setvariable adoc (car data_list) (cdr data_list))) (list (cons "DIMPOST" "") (cons "DIMAPOST" "") (cons "DIMSCALE" 1.0) (cons "DIMASZ" (getvar "DIMTXT")) (cons "DIMEXO" (/ (getvar "DIMTXT") 2.54)) (cons "DIMDLI" 0.38) (cons "DIMEXE" (/ (getvar "DIMTXT") 2.54)) (cons "DIMRND" 0.0) (cons "DIMDLE" (/ (getvar "DIMTXT") 2.54)) (cons "DIMTP" 0.0) (cons "DIMTM" 0.0) (cons "DIMCEN" 0.09) (cons "DIMTSZ" 0.0) (cons "DIMALTF" 25.4) (cons "DIMLFAC" 1.0) (cons "DIMTVP" 0.0) (cons "DIMTFAC" 1.0) (cons "DIMGAP" (/ (getvar "DIMTXT") 2.00)) (cons "DIMALTRND" 0.0) (cons "DIMTOL" 0) (cons "DIMLIM" 0) (cons "DIMTIH" 0) (cons "DIMTOH" 0) (cons "DIMSE1" 0) (cons "DIMSE2" 0) (cons "DIMTAD" 1) (cons "DIMZIN" 0) (cons "DIMALT" 0) (cons "DIMALTD" 2) (cons "DIMTOFL" 1) (cons "DIMSAH" 0) (cons "DIMTIX" 0) (cons "DIMSOXD" 0) (cons "DIMCLRD" 3) (cons "DIMCLRE" 1) (cons "DIMCLRT" 3) (cons "DIMADEC" 2) (cons "DIMDEC" 3) (cons "DIMTDEC" 3) (cons "DIMALTU" 6) (cons "DIMALTTD" 2) (cons "DIMAUNIT" 0) (cons "DIMFRAC" 2) (cons "DIMLUNIT" 2) (cons "DIMDSEP" ".") (cons "DIMTMOVE" 0) (cons "DIMJUST" 0) (cons "DIMSD1" 0) (cons "DIMSD2" 0) (cons "DIMTOLJ" 1) (cons "DIMTZIN" 0) (cons "DIMALTZ" 0) (cons "DIMALTTZ" 0) (cons "DIMUPT" 0) (cons "DIMATFIT" 3) (cons "DIMBLK" "_ARCHTICK") ) ) (vla-copyfrom obj_dim adoc) (vla-setvariable adoc "DIMBLK" ".") (vla-copyfrom obj_angdim adoc) (princ "\nSelect polylines: ") (while (null (setq pl (ssget '((0 . "LWPOLYLINE")))))) (repeat (setq n (sslength pl)) (setq ent (ssname pl (setq n (1- n))) obj (vlax-ename->vla-object ent) dxf_ent (entget ent) lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)) ) (vla-GetBoundingBox obj 'll 'ur) (setq ll (safearray-value ll) ur (safearray-value ur) dir_pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5)) base_pt (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt)) dir_ang (if (< (- (angle base_pt (polar base_pt (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (getvar "DIMTXT"))) (angle base_pt dir_pt)) pi) (* pi 0.5) (* pi 1.5) ) ) (if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent))))) (setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt)) (setq pr_pt nil) ) (while (cdr lst_pt) (vla-put-activedimstyle adoc obj_dim) (setq nw_obj (vla-addDimAligned space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))) ) ) (vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (+ dir_ang pi))(* 3.25 (getvar "DIMTXT")))) (if pr_pt (progn (vla-put-activedimstyle adoc obj_angdim) (setq nw_obj (vla-AddDimAngular space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point pr_pt) (vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 5.0 (getvar "DIMTXT")))) ) pr_pt (car lst_pt) ) ) (setq pr_pt (car lst_pt)) ) (setq lst_pt (cdr lst_pt)) ) (if (and pr_pt last_pt) (setq nw_obj (vla-AddDimAngular space (vlax-3d-point (car lst_pt)) (vlax-3d-point pr_pt) (vlax-3d-point last_pt) (vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 3.25 (getvar "DIMTXT")))) ) pr_pt (car lst_pt) ) ) ) (princ) ) I changed the variables DIMDEC=3, DIMTDEC=3 and DIMLUNIT=2. The variable DIMGAP was fixed at 0.09, I made it change with the height of the text so that the distance is proportionate to the dimension line. There was an error at the end of the program, it warned me of an unknown point and in fact the variable last_pt was nil. Very interesting little program. You don't have time to learn the dimension variables in one version of AutoCAD and Autodesk comes up with new variables, which I obviously don't remember, and as I've already told my buddy Mhupp, I'm lazy...
    1 point
  4. Of course, there are more "elegant" solutions by using VLisp, but here I used some of BIGAL's code and got the attached drawing. So, try this: ;;Offset selected polylines (defun C:OFFPOL (/ *error* cm do of obj1 obj2 ent1 ent2 ent3 end1 end2 pe st1 st2 s1 s2 s3 xx) (defun *error* (s) (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s))) (setvar "CMDECHO" cm) (setvar "DELOBJ" do) (setvar "PEDITACCEPT" pe) (princ) ) ;;*error* (setq cm (getvar "CMDECHO") do (getvar "DELOBJ") pe (getvar "PEDITACCEPT") s1 (ssget (quote ((0 . "LWPOLYLINE")))) ) (setvar "CMDECHO" 0) (setvar "DELOBJ" 1) (setvar "PEDITACCEPT" 1) (if s1 (progn (if (not (tblsearch "LAYER" "Offs")) (command "-LAYER" "_M" "Offs" "_C" 1 "Offs" "")) (setq of (getdist "Enter offset: ")) (if of (progn (repeat (setq xx (sslength s1)) (setq obj1 (vlax-ename->vla-object (ssname s1 (setq xx (1- xx))))) (vla-offset obj1 of) (setq ent1 (entlast) obj2 (vlax-ename->vla-object ent1) st1 (vlax-curve-getstartpoint obj2) end1 (vlax-curve-getendpoint obj2) ) (vla-offset obj1 (- of)) (setq ent2 (entlast) obj2 (vlax-ename->vla-object ent2) st2 (vlax-curve-getstartpoint obj2) end2 (vlax-curve-getendpoint obj2) ) (command "line" end2 end1 "") (setq ent3 (entlast)) (command "_.LINE" st1 st2 "" "_.PEDIT" (entlast) "_J" ent1 ent2 ent3 "" "_C" "" ) ) (setq s2 (ssget "_X" (quote ((0 . "LWPOLYLINE") (8 . "Offs")))) s3 (ssadd) ) (while (< xx (sslength s2)) (command "_.REGION" (ssname s2 xx) "") (ssadd (entlast) s3) (setq xx (1+ xx)) ) (command "_.UNION" s3 "" "_.EXPLODE" (entlast) ) ) ) ) ) (setvar "CMDECHO" cm) (setvar "DELOBJ" do) (setvar "PEDITACCEPT" pe) (princ) ) ;;OFFPOL OUTPUT (1).dwg
    1 point
×
×
  • Create New...