Welcome,
Guest
. Please
login
or
register
.
1 Hour
1 Day
1 Week
1 Month
Forever
Login with username, password and session length
News:
Home
Help
Login
Register
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
How to insert these set of dimensions?
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: How to insert these set of dimensions? (Read 2397 times)
0 Members and 1 Guest are viewing this topic.
HasanCAD
Swamp Rat
Posts: 1422
How to insert these set of dimensions?
«
on:
February 23, 2019, 03:37:05 PM »
Hi all
I am working on a Roads project.
The task is adding these dimesions
I tried several times to code this lisp but can not
Option one there is itermediate iland and another one is no itermediate island
attached a sample file
Thanks in advance
«
Last Edit: February 28, 2019, 09:16:23 AM by HasanCAD
»
Logged
Sorry for my English.
Donate to Theswamp
www.sergiwa.com
Tharwat
Swamp Rat
Posts: 710
Hypersensitive
WWW
Re: How to insert these set of dimensions?
«
Reply #1 on:
March 01, 2019, 04:21:01 PM »
Hi,
This should get you started and would sort the list of coordinates according to the shortest distance to point one ( variable 'p1' ) then you can iterate the coordinates and create the dimensions based on that.
Code - Auto/Visual Lisp:
[Select]
(
and
(
setq
p1
(
getpoint
"
\n
Specify first point :"
)
)
(
setq
p2
(
getpoint
"
\n
Next point :"
p1
)
)
(
setq
ss
(
ssget
"_C"
p1 p2 '
(
(
0
.
"LINE"
)
)
)
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
pts
(
cons
(
vlax-curve-getclosestpointto
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
p1
)
pts
)
)
)
(
setq
pts
(
vl-sort
pts '
(
lambda
(
a b
)
(
<
(
distance
p1 a
)
(
distance
p1 b
)
)
)
)
)
)
Logged
HVAC, Plumbing, Drainage, Electricity , Fire Fighting Programs and many more .....
HasanCAD
Swamp Rat
Posts: 1422
Re: How to insert these set of dimensions?
«
Reply #2 on:
March 01, 2019, 08:30:57 PM »
This What i ened up to
Created a cad file has a set of dimentions as 3 blocks then insert the block related to number of selected lines
the lisp working good for first selection of lines but the second
Attached the cad file and a screenshoot for the error
Thanks in advance
Code - Auto/Visual Lisp:
[Select]
(
DEFUN
C:RoadDimensionInsert
(
/
ANG BN BOBJ CLYR CNT DIS DISS DOC DTLST LST N1 OBJS OBJVL OSNP P1 P1N P2 PNTS
-
LST PNTS
-
LST
-
1
PNTS
-
LSTR PNTS
-
LSTS SPC SSLNGTH X
)
(
setq
*
acad
(
cond
(
*
acad
)
(
(
vlax-get-acad-object
)
)
)
)
(
setq
doc
(
vla-get-ActiveDocument
(
setq
*
acad
(
vlax-get-Acad-Object
)
)
)
spc
(
if
(
zerop
(
vla-get-activespace
doc
)
)
(
if
(
=
(
vla-get-mspace
doc
)
:vlax-true
)
(
vla-get-modelspace
doc
)
(
vla-get-paperspace
doc
)
)
(
vla-get-modelspace
doc
)
)
)
(
setq
uFlag
(
not
(
vla-StartUndoMark
doc
)
)
)
(
setq
osnp
(
getvar
"osmode"
)
)
(
setvar
"osmode"
0
)
(
setq
clyr
(
getvar
"CLAYER"
)
)
(
setq
diss
nil
)
(
setq
dtlst
nil
)
(
if
(
MakeLayer
"TEMP"
8
"Continuous"
0.01
nil
0
"TEMP LAYER"
)
(
progn
(
setq
clyr
(
getvar
"CLAYER"
)
)
(
setvar
"CLAYER"
"TEMP"
)
)
(
setvar
"CLAYER"
"Defpoints"
)
)
(
if
(
and
(
vl-cmdf
"_.-insert"
"C:/RoadDimension/RoadDimension.dwg"
"0,0,0"
"1"
"1"
"0"
)
; inser blocks
(
tblsearch
"BLOCK"
"RoadDimension"
)
)
(
progn
(
vl-cmdf
"_.erase"
"last"
""
)
(
vl-cmdf
"_.-purge"
"blocks"
"RoadDimension"
"n"
)
(
while
(
and
(
setq
p1
(
getpoint
"
\n
Pick Dimension Point at left side of road "
)
)
;(setvar "osmode" 128)
(
setq
p2
(
getpoint
p1
"
\n
Pick Dimension Point at right side of road"
)
)
)
(
setq
objs
(
ssget
"_C"
p1 p2
)
)
(
cond
(
(
=
10
(
setq
SSLngth
(
sslength
objs
)
)
)
(
HSN:10lines
)
)
(
(
=
8
(
setq
SSLngth
(
sslength
objs
)
)
)
(
HSN:8lines
)
)
(
(
=
6
(
setq
SSLngth
(
sslength
objs
)
)
)
(
HSN:6lines
)
)
(
T
(
alert
"
\n
No lines selected
\n
Try to isolate road lines then reuse the lisp"
)
)
)
(
setvar
"osmode"
osnp
)
(
setvar
"CLAYER"
clyr
)
(
setq
uFlag
(
vla-EndUndoMark
doc
)
)
)
)
)
)
(
defun
*error*
(
msg
)
(
and
uFlag
(
vla-EndUndoMark
doc
)
)
(
or
(
wcmatch
(
strcase
msg
)
"*BREAK,*CANCEL*,*EXIT*"
)
(
princ
(
strcat
"
\n
** Error: "
msg
" **"
)
)
)
(
setvar
"osmode"
osnp
)
(
setvar
"cmdecho"
cmd
)
(
princ
)
)
(
defun
HSN:10lines
(
/
)
(
repeat
(
setq
cnt
(
sslength
objs
)
)
(
setq
objVL
(
vlax
-
ename
->
vla-object
(
ssname
objs
(
setq
cnt
(
1-
cnt
)
)
)
)
)
(
setq
p1n
(
vlax-curve-getclosestpointto
objVL p1
)
)
(
setq
dtlst
(
cons
p1n dtlst
)
)
(
setq
dis
(
distance
p1 p1n
)
)
(
setq
diss
(
cons
dis diss
)
)
)
(
setq
lst
(
gc
:sort diss
<
)
)
(
setq
n1
(
nth
0
lst
)
)
(
setq
lst
(
mapcar
'
(
lambda
(
x
)
(
-
x n1
)
)
lst
)
)
(
setq
lst
(
vl-remove
(
nth
0
lst
)
lst
)
)
(
setq
pnts
-
lst
(
SortPointList 'XYZ 1e
-
3
<
<
<
dtlst
)
)
(
setq
pnts
-
lstS
(
vl-remove
(
nth
0
pnts
-
lst
)
pnts
-
lst
)
)
(
setq
pnts
-
lstR
(
reverse
pnts
-
lst
)
)
(
setq
pnts
-
lst
-
1
(
nth
0
pnts
-
lst
)
)
(
setq
ang
(
angle
pnts
-
lst
-
1
(
nth
0
pnts
-
lstR
)
)
)
(
setq
bn
(
strcat
"RoadDim-"
(
itoa
SSLngth
)
)
)
(
vl-catch-all-error-p
(
setq
bobj
(
vl
-
catch
-
all
-
apply
(
function
vla-InsertBlock
)
(
list
spc
(
vlax-3D-point
pnts
-
lst
-
1
)
bn
1.0
1.0
1.0
ang
)
)
)
)
(
LM:setdynprops
bobj
(
list
(
cons
"0"
(
nth
0
lst
)
)
(
cons
"1"
(
nth
1
lst
)
)
(
cons
"2"
(
nth
2
lst
)
)
(
cons
"3"
(
nth
3
lst
)
)
(
cons
"4"
(
nth
4
lst
)
)
(
cons
"5"
(
nth
5
lst
)
)
(
cons
"6"
(
nth
6
lst
)
)
(
cons
"7"
(
nth
7
lst
)
)
(
cons
"8"
(
nth
8
lst
)
)
)
)
(
command
"_.EXPLODE"
"Last"
)
)
(
defun
HSN:8lines
(
/
)
(
repeat
(
setq
cnt
(
sslength
objs
)
)
(
setq
objVL
(
vlax
-
ename
->
vla-object
(
ssname
objs
(
setq
cnt
(
1-
cnt
)
)
)
)
)
(
setq
p1n
(
vlax-curve-getclosestpointto
objVL p1
)
)
(
setq
dtlst
(
cons
p1n dtlst
)
)
(
setq
dis
(
distance
p1 p1n
)
)
(
setq
diss
(
cons
dis diss
)
)
)
(
setq
lst
(
gc
:sort diss
<
)
)
(
setq
n1
(
nth
0
lst
)
)
(
setq
lst
(
mapcar
'
(
lambda
(
x
)
(
-
x n1
)
)
lst
)
)
(
setq
lst
(
vl-remove
(
nth
0
lst
)
lst
)
)
(
setq
pnts
-
lst
(
SortPointList 'XYZ 1e
-
3
<
<
<
dtlst
)
)
(
setq
pnts
-
lstS
(
vl-remove
(
nth
0
pnts
-
lst
)
pnts
-
lst
)
)
(
setq
pnts
-
lstR
(
reverse
pnts
-
lst
)
)
(
setq
pnts
-
lst
-
1
(
nth
0
pnts
-
lst
)
)
(
setq
ang
(
angle
pnts
-
lst
-
1
(
nth
0
pnts
-
lstR
)
)
)
(
setq
bn
(
strcat
"RoadDim-0"
(
itoa
SSLngth
)
)
)
(
vl-catch-all-error-p
(
setq
bobj
(
vl
-
catch
-
all
-
apply
(
function
vla-InsertBlock
)
(
list
spc
(
vlax-3D-point
pnts
-
lst
-
1
)
bn
1.0
1.0
1.0
ang
)
)
)
)
(
LM:setdynprops
bobj
(
list
(
cons
"0"
(
nth
0
lst
)
)
(
cons
"1"
(
nth
1
lst
)
)
(
cons
"2"
(
nth
2
lst
)
)
(
cons
"3"
(
nth
3
lst
)
)
(
cons
"4"
(
nth
4
lst
)
)
(
cons
"5"
(
nth
5
lst
)
)
(
cons
"6"
(
nth
6
lst
)
)
)
)
(
command
"_.EXPLODE"
"Last"
)
)
(
defun
HSN:6lines
(
/
)
(
repeat
(
setq
cnt
(
sslength
objs
)
)
(
setq
objVL
(
vlax
-
ename
->
vla-object
(
ssname
objs
(
setq
cnt
(
1-
cnt
)
)
)
)
)
(
setq
p1n
(
vlax-curve-getclosestpointto
objVL p1
)
)
(
setq
dtlst
(
cons
p1n dtlst
)
)
(
setq
dis
(
distance
p1 p1n
)
)
(
setq
diss
(
cons
dis diss
)
)
)
(
setq
lst
(
gc
:sort diss
<
)
)
(
setq
n1
(
nth
0
lst
)
)
(
setq
lst
(
mapcar
'
(
lambda
(
x
)
(
-
x n1
)
)
lst
)
)
(
setq
lst
(
vl-remove
(
nth
0
lst
)
lst
)
)
(
setq
pnts
-
lst
(
SortPointList 'XYZ 1e
-
3
<
<
<
dtlst
)
)
(
setq
pnts
-
lstS
(
vl-remove
(
nth
0
pnts
-
lst
)
pnts
-
lst
)
)
(
setq
pnts
-
lstR
(
reverse
pnts
-
lst
)
)
(
setq
pnts
-
lst
-
1
(
nth
0
pnts
-
lst
)
)
(
setq
ang
(
angle
pnts
-
lst
-
1
(
nth
0
pnts
-
lstR
)
)
)
(
setq
bn
(
strcat
"RoadDim-0"
(
itoa
SSLngth
)
)
)
(
vl-catch-all-error-p
(
setq
bobj
(
vl
-
catch
-
all
-
apply
(
function
vla-InsertBlock
)
(
list
spc
(
vlax-3D-point
pnts
-
lst
-
1
)
bn
1.0
1.0
1.0
ang
)
)
)
)
(
LM:setdynprops
bobj
(
list
(
cons
"0"
(
nth
0
lst
)
)
(
cons
"1"
(
nth
1
lst
)
)
(
cons
"2"
(
nth
2
lst
)
)
(
cons
"3"
(
nth
3
lst
)
)
(
cons
"4"
(
nth
4
lst
)
)
)
)
(
command
"_.EXPLODE"
"Last"
)
)
;; Set Dynamic Block Properties - Lee Mac
;; Modifies values of Dynamic Block properties using a supplied association list.
;; blk - [vla] VLA Dynamic Block Reference object
;; lst - [lst] Association list of ((<Property> . <Value>) ... )
;; Returns: nil
(
defun
LM:setdynprops
(
blk lst
/
itm x
)
(
setq
lst
(
mapcar
'
(
lambda
(
x
)
(
cons
(
strcase
(
car
x
)
)
(
cdr
x
)
)
)
lst
)
)
(
foreach
x
(
vlax-invoke
blk 'getdynamicblockproperties
)
(
if
(
setq
itm
(
assoc
(
strcase
(
vla
-
get
-
propertyname x
)
)
lst
)
)
(
vla
-
put
-
value
x
(
vlax
-
make
-
variant
(
cdr
itm
)
(
vlax
-
variant
-
type
(
vla-get-value
x
)
)
)
)
)
)
)
; END DEFUN - LM:setdynprops
(
defun
SortPointList
(
fA fz dx dy dz pL
/
fp f
)
(
if
(
and
(
setq
fp
(
cadr
(
assoc
fA
(
list
(
list
'XYZ
(
lambda
(
a b c
)
(
if
a
(
if
b
(
if
c
(
dz z1 z2
)
(
dz z1 z2
)
)
(
dy y1 y2
)
)
(
dx x1 x2
)
)
)
)
(
list
'XZY
(
lambda
(
a b c
)
(
if
a
(
if
c
(
if
b
(
dy y1 y2
)
(
dy y1 y2
)
)
(
dz z1 z2
)
)
(
dx x1 x2
)
)
)
)
(
list
'YXZ
(
lambda
(
a b c
)
(
if
b
(
if
a
(
if
c
(
dz z1 z2
)
(
dz z1 z2
)
)
(
dx x1 x2
)
)
(
dy y1 y2
)
)
)
)
(
list
'YZX
(
lambda
(
a b c
)
(
if
b
(
if
c
(
if
a
(
dx x1 x2
)
(
dx x1 x2
)
)
(
dz z1 z2
)
)
(
dy y1 y2
)
)
)
)
(
list
'ZXY
(
lambda
(
a b c
)
(
if
c
(
if
a
(
if
b
(
dy y1 y2
)
(
dy y1 y2
)
)
(
dx x1 x2
)
)
(
dz z1 z2
)
)
)
)
(
list
'ZYX
(
lambda
(
a b c
)
(
if
c
(
if
b
(
if
a
(
dx x1 x2
)
(
dx x1 x2
)
)
(
dy y1 y2
)
)
(
dz z1 z2
)
)
)
)
)
)
)
)
(
setq
f
(
lambda
(
p1 p2
/
x1 y1 z1 x2 y2 z2 a b c
)
(
mapcar
'
set
'
(
x1 y1 z1
)
p1
)
(
mapcar
'
set
'
(
x2 y2 z2
)
p2
)
(
mapcar
'
set
'
(
a b c
)
(
mapcar
(
function
(
lambda
(
a b
)
(
equal
a b fz
)
)
)
p1 p2
)
)
(
fp a b c
)
)
)
)
(
vl-sort
pL
(
function
f
)
)
)
)
; defun SortPointList
(
defun
gc
:sort
(
lst fun
/
merge tmp
)
(
defun
merge
(
l1 l2
)
(
cond
(
(
null
l1
)
l2
)
(
(
null
l2
)
l1
)
(
(
fun
(
car
l1
)
(
car
l2
)
)
(
cons
(
car
l1
)
(
merge
(
cdr
l1
)
l2
)
)
)
(
T
(
cons
(
car
l2
)
(
merge l1
(
cdr
l2
)
)
)
)
)
)
(
setq
fun
(
eval
fun
)
lst
(
mapcar
'
list
lst
)
)
(
while
(
cdr
lst
)
(
setq
tmp lst lst
nil
)
(
while
(
cdr
tmp
)
(
setq
lst
(
cons
(
merge
(
car
tmp
)
(
cadr
tmp
)
)
lst
)
tmp
(
cddr
tmp
)
)
)
(
and
tmp
(
setq
lst
(
cons
(
car
tmp
)
lst
)
)
)
)
(
car
lst
)
)
(
defun
MakeLayer
(
name colour linetype lineweight willplot bitflag description
)
(
regapp
"AcAecLayerStandard"
)
;; (MakeLayer name colour linetype lineweight willplot bitflag description )
;; Specifications:
;; Description Data Type Remarks
;; ---------------------------------------------------------------------------------
;; Layer Name STRING Only standard chars allowed
;; Layer Colour INTEGER may be nil, -ve for Layer Off, Colour < 256
;; Layer Linetype STRING may be nil, If not loaded, CONTINUOUS.
;; Layer Lineweight REAL may be nil, 0 <= x <= 2.11
;; Plot? BOOLEAN T = Plot Layer, nil otherwise
;; Bit Flag INTEGER 0=None, 1=Frozen, 2=Frozen in VP, 4=Locked
;; Description STRING may be nil for no description
;; Function will return list detailing whether layer creation is successful.
;; © Lee Mac 2010
(
or
(
tblsearch
"LAYER"
name
)
(
entmake
(
append
(
list
(
cons
0
"LAYER"
)
(
cons
100
"AcDbSymbolTableRecord"
)
(
cons
100
"AcDbLayerTableRecord"
)
(
cons
2
name
)
(
cons
70
bitflag
)
(
cons
290
(
if
willplot
1
0
)
)
(
cons
6
(
if
(
and
linetype
(
tblsearch
"LTYPE"
linetype
)
)
linetype
"CONTINUOUS"
)
)
(
cons
62
(
if
(
and
colour
(
<
0
(
abs
colour
)
256
)
)
colour
7
)
)
(
cons
370
(
fix
(
*
100
(
if
(
and
lineweight
(
<=
0.0
lineweight
2.11
)
)
lineweight
0.0
)
)
)
)
)
(
if
description
(
list
(
list
-
3
(
list
"AcAecLayerStandard"
(
cons
1000
""
)
(
cons
1000
description
)
)
)
)
)
)
)
)
)
Logged
Sorry for my English.
Donate to Theswamp
www.sergiwa.com
Tharwat
Swamp Rat
Posts: 710
Hypersensitive
WWW
Re: How to insert these set of dimensions?
«
Reply #3 on:
March 02, 2019, 04:42:18 AM »
Hi,
Try the following program and be sure is that the program would select the crossed Line objects only and ignores polylines and I am raising this issue because you already have polyline objects among the lines that represents the road routes as in the above attached sample drawing.
Code - Auto/Visual Lisp:
[Select]
(
defun
c:dimroad
(
/
p1 p2 ss i bkn int pts doc ins ang blk prs bse
)
;; Tharwat - 02.Mar.2019 ;;
(
if
(
and
(
setq
p1
(
getpoint
"
\n
Specify first point :"
)
)
(
setq
p2
(
getpoint
"
\n
Next point :"
p1
)
)
(
setq
ss
(
ssget
"_C"
p1 p2 '
(
(
0
.
"LINE"
)
)
)
)
(
setq
i
(
sslength
ss
)
)
(
if
(
or
(
=
i
6
)
(
=
i
8
)
(
=
i
10
)
)
(
or
(
tblsearch
"BLOCK"
(
setq
bkn
(
strcat
"RoadDim-"
(
if
(
=
i
10
)
"10"
(
strcat
"0"
(
itoa
i
)
)
)
)
)
)
(
alert
(
strcat
"Block name <"
bkn
"> not found in current drawing."
)
)
)
(
alert
"Number of collected lines are not equal to 6 or 8 nor to 10"
)
)
(
setq
int
-
1
)
(
repeat
i
(
setq
pts
(
cons
(
vlax-curve-getclosestpointto
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
p1
)
pts
)
)
)
(
setq
pts
(
vl-sort
pts
'
(
lambda
(
a b
)
(
<
(
distance
p1 a
)
(
distance
p1 b
)
)
)
)
)
(
setq
doc
(
vla-get-ActiveDocument
(
vlax-get-Acad-Object
)
)
ins
(
last
pts
)
ang
(
angle
(
car
pts
)
ins
)
)
(
if
(
and
(
>
ang
(
*
pi
0.5
)
)
(
<
ang
(
*
pi
1.5
)
)
)
(
setq
ang
(
+
pi ang
)
)
(
setq
ins
(
car
pts
)
)
)
)
(
progn
(
vla-endUndomark
doc
)
(
vla-StartUndoMark
doc
)
(
setq
blk
(
entmakex
(
list
'
(
0
.
"INSERT"
)
(
cons
10
ins
)
(
cons
2
bkn
)
(
cons
50
ang
)
'
(
41
.
1.0
)
'
(
42
.
1.0
)
'
(
43
.
1.0
)
)
)
prs
(
vlax-invoke
(
vlax
-
ename
->
vla-object
blk
)
'getdynamicBlockproperties
)
pts
(
reverse
pts
)
bse
(
car
pts
)
)
(
mapcar
'
(
lambda
(
d
)
(
setq
int
(
1+
int
)
)
(
vl-some
'
(
lambda
(
x
)
(
if
(
=
(
vla
-
get
-
propertyname x
)
(
itoa
int
)
)
(
progn
(
vlax-put
x 'Value
(
distance
bse d
)
)
t
)
)
)
prs
)
)
(
cdr
pts
)
)
(
vla-endUndomark
doc
)
)
)
(
princ
)
)
(
vl-load-com
)
Logged
HVAC, Plumbing, Drainage, Electricity , Fire Fighting Programs and many more .....
HasanCAD
Swamp Rat
Posts: 1422
Re: How to insert these set of dimensions?
«
Reply #4 on:
March 03, 2019, 12:00:55 PM »
OK
Thanks for your lisp but whats making my lisp not working.
Logged
Sorry for my English.
Donate to Theswamp
www.sergiwa.com
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
How to insert these set of dimensions?